text-show-3.6/0000755000000000000000000000000013077013176011517 5ustar0000000000000000text-show-3.6/CHANGELOG.md0000644000000000000000000005763113077013176013344 0ustar0000000000000000### 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.6/README.md0000644000000000000000000000403013077013176012773 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] [![Build](https://img.shields.io/travis/RyanGlScott/text-show.svg)](https://travis-ci.org/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). At the moment, `text-show` provides instances for most data types in the [`array`](http://hackage.haskell.org/package/array), [`base`](http://hackage.haskell.org/package/base), [`bytestring`](http://hackage.haskell.org/package/bytestring), and [`text`](http://hackage.haskell.org/package/text) packages. Therefore, much of the source code for `text-show` consists of borrowed code from those packages in order to ensure that the behaviors of `Show` and `TextShow` coincide. For most uses, simply importing `TextShow` will suffice: ```haskell module Main where import TextShow main :: IO () main = printT (Just "Hello, World!") ``` If you desire it, there are also monomorphic versions of the `showb` function available in the submodules of `Text.Show.Text`. See the [naming conventions](https://github.com/RyanGlScott/text-show/wiki/Naming-conventions) page for more information. Support for automatically deriving `TextShow` instances can be found in the `TextShow.TH` and `TextShow.Generic` modules. text-show-3.6/text-show.cabal0000644000000000000000000004674413077013176014464 0ustar0000000000000000name: text-show version: 3.6 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 @@. . At the moment, @text-show@ provides instances for most data types in the @@, @@, @@, and @@ packages. Therefore, much of the source code for @text-show@ consists of borrowed code from those packages in order to ensure that the behaviors of @Show@ and @TextShow@ coincide. . For most uses, simply importing "TextShow" will suffice: . @ module Main where . import TextShow . main :: IO () main = printT (Just \"Hello, World!\") @ . If you desire it, there are also monomorphic versions of the @showb@ function available in the submodules of "TextShow". See the page for more information. . Support for automatically deriving @TextShow@ instances can be found in the "TextShow.TH" and "TextShow.Generic" modules. 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.0.4 , GHC == 7.2.2 , GHC == 7.4.2 , GHC == 7.6.3 , GHC == 7.8.4 , GHC == 7.10.3 , GHC == 8.0.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 developer description: Operate in developer mode (allows for faster recompilation of tests) default: False manual: True flag base-4-9 description: Use base-4.9 or later. default: True flag template-haskell-2-11 description: Use template-haskell-2.11.0.0 or later. default: True flag new-functor-classes description: Use a version of transformers or transformers-compat with a modern-style Data.Functor.Classes module. This flag cannot be used when building with transformers-0.4, since it comes with a different version of Data.Functor.Classes. default: True library exposed-modules: TextShow TextShow.Control.Applicative TextShow.Control.Concurrent TextShow.Control.Exception TextShow.Control.Monad.ST TextShow.Data.Array 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.Generics 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 base >= 4.4 TextShow.GHC.Fingerprint -- Only exports functions if base >= 4.4 and not using Windows TextShow.GHC.Event -- Only exports functions if base >= 4.5 TextShow.GHC.Stats -- 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 >= 0.8.1 && < 1 , bifunctors >= 5.1 && < 6 , bytestring >= 0.9 && < 0.11 , bytestring-builder , containers >= 0.1 && < 0.6 , contravariant >= 0.5 && < 2 , generic-deriving >= 1.11 && < 2 , ghc-prim , integer-gmp , nats >= 0.1 && < 2 , semigroups >= 0.17 && < 1 , tagged >= 0.4.4 && < 1 , text >= 0.11.1 && < 1.3 , th-lift >= 0.7.6 && < 1 , void >= 0.5 && < 1 if flag(base-4-9) build-depends: base >= 4.9 && < 5 cpp-options: "-DNEW_FUNCTOR_CLASSES" else build-depends: base >= 4.3 && < 4.9 if flag(template-haskell-2-11) build-depends: template-haskell >= 2.11 && < 2.13 , ghc-boot-th >= 8.0 && < 8.3 else build-depends: template-haskell >= 2.5 && < 2.11 if flag(new-functor-classes) build-depends: transformers (>= 0.2.1 && < 0.4) || (>= 0.5 && < 0.6) , transformers-compat >= 0.5 && < 1 cpp-options: "-DNEW_FUNCTOR_CLASSES" else build-depends: transformers == 0.4.* hs-source-dirs: src, shared default-language: Haskell2010 ghc-options: -Wall include-dirs: include 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.TypeSynonyms Instances.Control.Concurrent Instances.Control.Exception Instances.Control.Monad.ST Instances.Data.ByteString Instances.Data.Char Instances.Data.Data Instances.Data.Dynamic Instances.Data.Floating Instances.Data.Functor.Compose Instances.Data.Functor.Product Instances.Data.Functor.Sum Instances.Data.Ord Instances.Data.Proxy 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.Generics Instances.Options Instances.System.Exit 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 base >= 4.4 Instances.GHC.Fingerprint -- Only exports instances if base >= 4.4 and not using Windows Instances.GHC.Event -- Only exports instances if base >= 4.5 Instances.GHC.Stats -- 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 Spec.BuilderSpec Spec.Control.ApplicativeSpec Spec.Control.ConcurrentSpec Spec.Control.ExceptionSpec Spec.Control.Monad.STSpec Spec.Data.ArraySpec 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.DatatypeContextsSpec Spec.Derived.ExistentialQuantificationSpec Spec.Derived.InfixSpec Spec.Derived.MagicHashSpec Spec.Derived.PolyKindsSpec Spec.Derived.RankNTypesSpec Spec.Derived.RecordsSpec Spec.Derived.TypeSynonymsSpec Spec.Foreign.C.TypesSpec Spec.Foreign.PtrSpec Spec.FromStringTextShowSpec Spec.FunctionsSpec Spec.GenericSpec Spec.GHC.GenericsSpec 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 base >= 4.4 Spec.GHC.FingerprintSpec -- Only exports tests if base >= 4.4 and not using Windows Spec.GHC.EventSpec -- Only exports tests if base >= 4.5 Spec.GHC.StatsSpec -- Only exports tests if template-haskell >= 2.7 Spec.Derived.DataFamiliesSpec -- 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 build-depends: array >= 0.3 && < 0.6 , base-compat >= 0.8.2 && < 1 , base-orphans >= 0.6 && < 0.7 , bifunctors >= 5.1 && < 6 , bytestring >= 0.9 && < 0.11 , bytestring-builder , containers >= 0.1 && < 0.6 , contravariant >= 0.5 && < 2 , deriving-compat >= 0.3.4 && < 1 , generic-deriving >= 1.11 && < 2 , ghc-prim , hspec >= 2 && < 3 , integer-gmp , nats >= 0.1 && < 2 , QuickCheck >= 2.9 && < 3 , quickcheck-instances >= 0.1 && < 0.4 , semigroups >= 0.18.3 && < 1 , tagged >= 0.8.3 && < 1 , text >= 0.11.1 && < 1.3 , th-lift >= 0.7.6 && < 1 , transformers-compat >= 0.5 && < 1 , void >= 0.5 && < 1 if flag(base-4-9) build-depends: base >= 4.9 && < 5 cpp-options: "-DNEW_FUNCTOR_CLASSES" else build-depends: base >= 4.3 && < 4.9 if flag(template-haskell-2-11) build-depends: template-haskell >= 2.11 && < 2.13 , ghc-boot-th >= 8.0 && < 8.3 else build-depends: template-haskell >= 2.5 && < 2.11 if flag(new-functor-classes) build-depends: transformers (>= 0.2.1 && < 0.4) || (>= 0.5 && < 0.6) cpp-options: "-DNEW_FUNCTOR_CLASSES" else build-depends: transformers == 0.4.* if flag(developer) hs-source-dirs: src else build-depends: text-show hs-source-dirs: tests, shared default-language: Haskell2010 ghc-options: -Wall -threaded -rtsopts include-dirs: include includes: generic.h , overlap.h benchmark bench if impl(ghc < 7.4) buildable: False type: exitcode-stdio-1.0 main-is: Bench.hs build-depends: array >= 0.3 && < 0.6 , base-compat >= 0.8.1 && < 1 , bifunctors >= 5.1 && < 6 , bytestring >= 0.9 && < 0.11 , bytestring-builder , containers >= 0.1 && < 0.6 , contravariant >= 0.5 && < 2 , criterion >= 1.1.4 && < 2 , deepseq >= 1.3 && < 2 , generic-deriving >= 1.11 && < 2 , ghc-prim , integer-gmp , nats >= 0.1 && < 2 , semigroups >= 0.17 && < 1 , tagged >= 0.4.4 && < 1 , text >= 0.11.1 && < 1.3 , th-lift >= 0.7.6 && < 1 , void >= 0.5 && < 1 if flag(base-4-9) build-depends: base >= 4.9 && < 5 cpp-options: "-DNEW_FUNCTOR_CLASSES" else build-depends: base >= 4.5 && < 4.9 if flag(template-haskell-2-11) build-depends: template-haskell >= 2.11 && < 2.13 , ghc-boot-th >= 8.0 && < 8.3 else build-depends: template-haskell >= 2.5 && < 2.11 if flag(new-functor-classes) build-depends: transformers (>= 0.2.1 && < 0.4) || (>= 0.5 && < 0.6) , transformers-compat >= 0.5 && < 1 cpp-options: "-DNEW_FUNCTOR_CLASSES" else build-depends: transformers == 0.4.* if flag(developer) hs-source-dirs: src else build-depends: text-show hs-source-dirs: benchmarks, shared default-language: Haskell2010 ghc-options: -Wall include-dirs: include text-show-3.6/LICENSE0000644000000000000000000000276313077013176012534 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.6/Setup.hs0000644000000000000000000000005613077013176013154 0ustar0000000000000000import Distribution.Simple main = defaultMain text-show-3.6/include/0000755000000000000000000000000013077013176013142 5ustar0000000000000000text-show-3.6/include/generic.h0000644000000000000000000000047513077013176014735 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.6/include/overlap.h0000644000000000000000000000065013077013176014764 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.6/src/0000755000000000000000000000000013077013176012306 5ustar0000000000000000text-show-3.6/src/TextShow.hs0000644000000000000000000000416613077013176014436 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.6/src/TextShow/0000755000000000000000000000000013077013176014073 5ustar0000000000000000text-show-3.6/src/TextShow/Utils.hs0000644000000000000000000000630113077013176015527 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 ( coerce , i2d , isInfixDataCon , isSymVar , isTupleString , lengthB , toString , toText , unlinesB , unwordsB ) where import Data.Int (Int64) import Data.Text (Text) import Data.Monoid.Compat ((<>)) import Data.Text.Lazy (length, toStrict, unpack) import Data.Text.Lazy.Builder (Builder, singleton, toLazyText) import GHC.Exts (Char(C#), Int(I#)) import GHC.Prim ((+#), chr#, ord#) import Prelude () import Prelude.Compat hiding (length) #if __GLASGOW_HASKELL__ >= 708 import qualified Data.Coerce as C (Coercible, coerce) #else import Unsafe.Coerce (unsafeCoerce) #endif #if defined(MIN_VERSION_ghc_boot_th) import GHC.Lexeme (startsVarSym) #else import Data.Char (isSymbol, ord) #endif -- | On GHC 7.8 and later, this is 'C.coerce' from "Data.Coerce". Otherwise, it's -- 'unsafeCoerce'. #if __GLASGOW_HASKELL__ >= 708 coerce :: C.Coercible a b => a -> b coerce = C.coerce #else coerce :: a -> b coerce = unsafeCoerce #endif -- | Unsafe conversion for decimal digits. i2d :: Int -> Char 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.6/src/TextShow/TH.hs0000644000000000000000000000137413077013176014747 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 ''Options) $(deriveTextShow ''GenTextMethods) text-show-3.6/src/TextShow/Classes.hs0000644000000000000000000004532613077013176016036 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} #if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE StandaloneDeriving #-} #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 #if __GLASGOW_HASKELL__ >= 708 import Data.Data (Typeable) #endif import Data.Monoid.Compat ((<>)) 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 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.Monoid -- 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 'genericShowbPrec'. -- -- /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 #if __GLASGOW_HASKELL__ >= 708 {-# MINIMAL showbPrec | showb #-} deriving instance Typeable TextShow #endif -- | 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 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) #if __GLASGOW_HASKELL__ >= 708 {-# MINIMAL liftShowbPrec #-} deriving instance Typeable TextShow1 #endif -- | 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 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) #if __GLASGOW_HASKELL__ >= 708 {-# MINIMAL liftShowbPrec2 #-} deriving instance Typeable TextShow2 #endif -- | 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.6/src/TextShow/Options.hs0000644000000000000000000000515613077013176016071 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} #endif #if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE AutoDeriveTypeable #-} #endif #if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE DeriveLift #-} #endif {-| Module: TextShow.FromStringTextShow 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) #if __GLASGOW_HASKELL__ >= 702 import GHC.Generics (Generic) #else import qualified Generics.Deriving.TH as Generics #endif import Language.Haskell.TH.Lift -- | Options that specify how to derive 'TextShow' instances using Template Haskell. -- -- /Since: 3.4/ newtype Options = Options { genTextMethods :: GenTextMethods -- ^ When Template Haskell should generate definitions for methods which -- return @Text@? } deriving ( Data , Eq , Ord , Read , Show , Typeable #if __GLASGOW_HASKELL__ >= 702 , Generic #endif #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 , Ix , Ord , Read , Show , Typeable #if __GLASGOW_HASKELL__ >= 702 , Generic #endif #if __GLASGOW_HASKELL__ >= 800 , Lift #endif ) -- | Sensible default 'Options'. -- -- /Since: 3.4/ defaultOptions :: Options defaultOptions = Options { genTextMethods = SometimesTextMethods } ------------------------------------------------------------------------------- #if __GLASGOW_HASKELL__ < 702 $(Generics.deriveAll ''Options) $(Generics.deriveAll ''GenTextMethods) #endif #if __GLASGOW_HASKELL__ < 800 $(deriveLift ''Options) $(deriveLift ''GenTextMethods) #endif text-show-3.6/src/TextShow/Instances.hs0000644000000000000000000000470713077013176016366 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.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.6/src/TextShow/FromStringTextShow.hs0000644000000000000000000005322313077013176020234 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} #endif #if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE AutoDeriveTypeable #-} #endif #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.Data (Data, Typeable) import Data.Functor.Classes (Show1(..)) #if !defined(__LANGUAGE_DERIVE_GENERIC1__) import qualified Generics.Deriving.TH as Generics #endif #if __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic, Generic1) #endif 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) import TextShow.Utils (coerce) #if defined(NEW_FUNCTOR_CLASSES) import Data.Functor.Classes (Show2(..), showsPrec1, showsPrec2) #else import Text.Show (showListWith) #endif ------------------------------------------------------------------------------- -- | 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 #if __GLASGOW_HASKELL__ >= 706 , Generic , Generic1 #endif #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) instance Show1 FromStringShow where #if defined(NEW_FUNCTOR_CLASSES) liftShowList _ sl = sl . coerceList where coerceList :: [FromStringShow a] -> [a] coerceList = coerce liftShowsPrec sp _ p = sp p . fromStringShow #else showsPrec1 p = showsPrec p . fromStringShow #endif instance TextShow1 FromStringShow where liftShowbPrec sp' _ p = showsPrecToShowbPrec (showbPrecToShowsPrec sp') p . fromStringShow liftShowbList _ sl' = showsToShowb (showbToShows sl') . coerceList where coerceList :: [FromStringShow a] -> [a] coerceList = coerce ------------------------------------------------------------------------------- -- | The @String@ 'Show' instance for 'FromTextShow' is based on its -- 'TextShow' instance. That is, -- -- @ -- showsPrec p ('FromTextShow' x) = 'showbToShows' 'showbPrec' p x -- @ -- -- /Since: 2/ newtype FromTextShow a = FromTextShow { fromTextShow :: a } deriving ( Data , Eq , Foldable , Functor #if __GLASGOW_HASKELL__ >= 706 , Generic , Generic1 #endif #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]) instance Show1 FromTextShow where #if defined(NEW_FUNCTOR_CLASSES) liftShowList _ sl = showbToShows (showsToShowb sl) . coerceList where coerceList :: [FromTextShow a] -> [a] coerceList = coerce liftShowsPrec sp _ p = showbPrecToShowsPrec (showsPrecToShowbPrec sp) p . fromTextShow #else showsPrec1 p = showbPrecToShowsPrec (showsPrecToShowbPrec showsPrec) p . fromTextShow #endif instance TextShow1 FromTextShow where liftShowbPrec sp' _ p = sp' p . fromTextShow liftShowbList _ sl' = sl' . coerceList where coerceList :: [FromTextShow a] -> [a] coerceList = coerce ------------------------------------------------------------------------------- -- | 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 #if __GLASGOW_HASKELL__ >= 706 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #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) # if __GLASGOW_HASKELL__ >= 708 deriving instance Typeable FromStringShow1 deriving instance ( Data (f a), Typeable f, Typeable a ) => Data (FromStringShow1 f (a :: *)) # endif #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@ instance (Show1 f, Show a) => TextShow (FromStringShow1 f a) where showbPrec = liftShowbPrec (showsPrecToShowbPrec showsPrec) (showsToShowb showList) showbList = liftShowbList (showsPrecToShowbPrec showsPrec) (showsToShowb showList) -- | Not available if using @transformers-0.4@ instance Show1 f => TextShow1 (FromStringShow1 f) where liftShowbPrec sp sl p = showsPrecToShowbPrec (liftShowsPrec (showbPrecToShowsPrec sp) (showbToShows sl)) p . fromStringShow1 liftShowbList sp sl = showsToShowb (liftShowList (showbPrecToShowsPrec sp) (showbToShows sl)) . coerceList where coerceList :: [FromStringShow1 f a] -> [f a] coerceList = coerce #endif instance (Show1 f, Show a) => Show (FromStringShow1 f a) where showsPrec = showsPrec1 showList = liftShowList showsPrec showList ------------------------------------------------------------------------------- -- | The @String@ 'Show1' instance for 'FromTextShow1' is based on its -- 'TextShow1' instance. That is, -- -- @ -- 'liftShowsPrec' sp sl p ('FromTextShow1' x) = -- 'showbPrecToShowsPrec' ('liftShowbPrec' ('showsPrecToShowbPrec' sp) -- ('showsToShowb' sl)) -- p x -- @ -- -- /Since: 3/ newtype FromTextShow1 f a = FromTextShow1 { fromTextShow1 :: f a } deriving ( Eq , Ord #if __GLASGOW_HASKELL__ >= 706 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #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) # if __GLASGOW_HASKELL__ >= 708 deriving instance Typeable FromTextShow1 deriving instance ( Data (f a), Typeable f, Typeable a ) => Data (FromTextShow1 f (a :: *)) # endif #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@ instance (TextShow1 f, TextShow a) => Show (FromTextShow1 f a) where showsPrec = liftShowsPrec (showbPrecToShowsPrec showbPrec) (showbToShows showbList) showList = liftShowList (showbPrecToShowsPrec showbPrec) (showbToShows showbList) #endif instance TextShow1 f => Show1 (FromTextShow1 f) where #if 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 ------------------------------------------------------------------------------- -- | 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 #if __GLASGOW_HASKELL__ >= 706 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #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) # if __GLASGOW_HASKELL__ >= 708 deriving instance Typeable FromStringShow2 deriving instance ( Data (f a b), Typeable f, Typeable a, Typeable b ) => Data (FromStringShow2 f (a :: *) (b :: *)) # endif #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@ instance (Show2 f, Show a, Show b) => TextShow (FromStringShow2 f a b) where showbPrec = liftShowbPrec (showsPrecToShowbPrec showsPrec) (showsToShowb showList) showbList = liftShowbList (showsPrecToShowbPrec showsPrec) (showsToShowb showList) -- | Not available if using @transformers-0.4@ instance (Show2 f, Show a) => TextShow1 (FromStringShow2 f a) where liftShowbPrec = liftShowbPrec2 (showsPrecToShowbPrec showsPrec) (showsToShowb showList) liftShowbList = liftShowbList2 (showsPrecToShowbPrec showsPrec) (showsToShowb showList) -- | Not available if using @transformers-0.4@ instance Show2 f => TextShow2 (FromStringShow2 f) where liftShowbPrec2 sp1 sl1 sp2 sl2 p = showsPrecToShowbPrec (liftShowsPrec2 (showbPrecToShowsPrec sp1) (showbToShows sl1) (showbPrecToShowsPrec sp2) (showbToShows sl2)) p . fromStringShow2 liftShowbList2 sp1 sl1 sp2 sl2 = showsToShowb (liftShowList2 (showbPrecToShowsPrec sp1) (showbToShows sl1) (showbPrecToShowsPrec sp2) (showbToShows sl2)) . coerceList where coerceList :: [FromStringShow2 f a b] -> [f a b] coerceList = coerce -- | Not available if using @transformers-0.4@ instance (Show2 f, Show a, Show b) => Show (FromStringShow2 f a b) where showsPrec = showsPrec2 showList = liftShowList2 showsPrec showList showsPrec showList -- | Not available if using @transformers-0.4@ instance (Show2 f, Show a) => Show1 (FromStringShow2 f a) where liftShowsPrec = liftShowsPrec2 showsPrec showList liftShowList = liftShowList2 showsPrec showList #endif ------------------------------------------------------------------------------- -- | The @String@ 'Show2' instance for 'FromTextShow2' is based on its -- 'TextShow2' instance. That is, -- -- @ -- liftShowsPrec2 sp1 sl1 sp2 sl2 p ('FromTextShow2' x) = -- 'showbPrecToShowsPrec' ('liftShowbPrec2' ('showsPrecToShowbPrec' sp1) -- ('showsToShowb' sl1) -- ('showsPrecToShowbPrec' sp2) -- ('showsToShowb' sl2)) -- p x -- @ -- -- /Since: 3/ newtype FromTextShow2 f a b = FromTextShow2 { fromTextShow2 :: f a b } deriving ( Eq , Ord #if __GLASGOW_HASKELL__ >= 706 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #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) # if __GLASGOW_HASKELL__ >= 708 deriving instance Typeable FromTextShow2 deriving instance ( Data (f a b), Typeable f, Typeable a, Typeable b ) => Data (FromTextShow2 f (a :: *) (b :: *)) # endif #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@ instance (TextShow2 f, TextShow a, TextShow b) => Show (FromTextShow2 f a b) where showsPrec = liftShowsPrec (showbPrecToShowsPrec showbPrec) (showbToShows showbList) showList = liftShowList (showbPrecToShowsPrec showbPrec) (showbToShows showbList) -- | Not available if using @transformers-0.4@ instance (TextShow2 f, TextShow a) => Show1 (FromTextShow2 f a) where liftShowsPrec = liftShowsPrec2 (showbPrecToShowsPrec showbPrec) (showbToShows showbList) liftShowList = liftShowList2 (showbPrecToShowsPrec showbPrec) (showbToShows showbList) -- | Not available if using @transformers-0.4@ instance TextShow2 f => Show2 (FromTextShow2 f) where liftShowsPrec2 sp1 sl1 sp2 sl2 p = showbPrecToShowsPrec (liftShowbPrec2 (showsPrecToShowbPrec sp1) (showsToShowb sl1) (showsPrecToShowbPrec sp2) (showsToShowb sl2)) p . fromTextShow2 liftShowList2 sp1 sl1 sp2 sl2 = showbToShows (liftShowbList2 (showsPrecToShowbPrec sp1) (showsToShowb sl1) (showsPrecToShowbPrec sp2) (showsToShowb sl2)) . coerceList where coerceList :: [FromTextShow2 f a b] -> [f a b] coerceList = coerce #endif instance (TextShow2 f, TextShow a, TextShow b) => TextShow (FromTextShow2 f a b) where showbPrec = showbPrec2 showbList = liftShowbList2 showbPrec showbList showbPrec showbList instance (TextShow2 f, TextShow a) => TextShow1 (FromTextShow2 f a) where liftShowbPrec = liftShowbPrec2 showbPrec showbList liftShowbList = liftShowbList2 showbPrec showbList ------------------------------------------------------------------------------- #if !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 #if __GLASGOW_HASKELL__ < 706 $(Generics.deriveAll0And1 ''FromStringShow) $(Generics.deriveAll0And1 ''FromTextShow) $(Generics.deriveRepresentable0 ''FromStringShow1) $(Generics.deriveRepresentable0 ''FromStringShow2) $(Generics.deriveRepresentable0 ''FromTextShow1) $(Generics.deriveRepresentable0 ''FromTextShow2) #endif text-show-3.6/src/TextShow/Functions.hs0000644000000000000000000000153113077013176016377 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.6/src/TextShow/Generic.hs0000644000000000000000000007216413077013176016015 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} #endif #if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE DeriveLift #-} #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 @show@ functions -- $generics -- ** Understanding a compiler error -- $generic_err genericShowt , genericShowtl , genericShowtPrec , genericShowtlPrec , genericShowtList , genericShowtlList , genericShowb , genericShowbPrec , genericShowbList , genericPrintT , genericPrintTL , genericHPrintT , genericHPrintTL , genericLiftShowbPrec , genericShowbPrec1 -- * Internals -- ** 'Builder' , GTextShowB(..) , GTextShowConB(..) , ShowFunsB(..) -- ** Strict 'TS.Text' , GTextShowT(..) , GTextShowConT(..) , ShowFunsT(..) -- ** Lazy 'TL.Text' , GTextShowTL(..) , GTextShowConTL(..) , ShowFunsTL(..) -- ** Other internals , IsNullary(..) , ConType(..) , Zero , One ) where import Data.Data (Data, Typeable) import Data.Functor.Contravariant (Contravariant(..)) import Data.Monoid.Compat ((<>)) 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 __GLASGOW_HASKELL__ < 702 import qualified Generics.Deriving.TH as Generics (deriveAll) #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. The easiest way to do this is to use the @DeriveGeneric@ extension. @ {-# LANGUAGE DeriveGeneric #-} import GHC.Generics import TextShow import TextShow.Generic data D a = D a deriving (Generic, Generic1) instance TextShow a => TextShow (D a) where showbPrec = 'genericShowbPrec' instance TextShow1 D where liftShowbPrec = 'genericLiftShowbPrec' @ -} {- $generic_err Suppose you intend to use 'genericShowbPrec' to define a 'TextShow' instance. @ data Oops = Oops -- forgot to add \"deriving Generic\" here! instance TextShow Oops where showbPrec = 'genericShowbPrec' @ If you forget to add a @deriving 'Generic'@ clause to your data type, at compile-time, you might get an error message that begins roughly as follows: @ No instance for ('GTextShowB' 'Zero' (Rep Oops)) @ This error can be confusing, but don't let it intimidate you. The correct fix is simply to add the missing \"@deriving 'Generic'@\" clause. Similarly, if the compiler complains about not having an instance for @('GTextShowB' 'One' (Rep1 Oops1))@, add a \"@deriving 'Generic1'@\" clause. -} -- | A 'Generic' implementation of 'showt'. -- -- /Since: 2/ genericShowt :: (Generic a, GTextShowT Zero (Rep a)) => a -> TS.Text genericShowt = genericShowtPrec 0 -- | A 'Generic' implementation of 'showtl'. -- -- /Since: 2/ genericShowtl :: (Generic a, GTextShowTL Zero (Rep a)) => a -> TL.Text genericShowtl = genericShowtlPrec 0 -- | A 'Generic' implementation of 'showPrect'. -- -- /Since: 2/ genericShowtPrec :: (Generic a, GTextShowT Zero (Rep a)) => Int -> a -> TS.Text genericShowtPrec p = gShowtPrec NoShowFunsT p . from -- | A 'Generic' implementation of 'showtlPrec'. -- -- /Since: 2/ genericShowtlPrec :: (Generic a, GTextShowTL Zero (Rep a)) => Int -> a -> TL.Text genericShowtlPrec p = gShowtlPrec NoShowFunsTL p . from -- | A 'Generic' implementation of 'showtList'. -- -- /Since: 2/ genericShowtList :: (Generic a, GTextShowT Zero (Rep a)) => [a] -> TS.Text genericShowtList = showtListWith genericShowt -- | A 'Generic' implementation of 'showtlList'. -- -- /Since: 2/ genericShowtlList :: (Generic a, GTextShowTL Zero (Rep a)) => [a] -> TL.Text genericShowtlList = showtlListWith genericShowtl -- | A 'Generic' implementation of 'showb'. -- -- /Since: 2/ genericShowb :: (Generic a, GTextShowB Zero (Rep a)) => a -> Builder genericShowb = genericShowbPrec 0 -- | A 'Generic' implementation of 'showbPrec'. -- -- /Since: 2/ genericShowbPrec :: (Generic a, GTextShowB Zero (Rep a)) => Int -> a -> Builder genericShowbPrec p = gShowbPrec NoShowFunsB p . from -- | A 'Generic' implementation of 'showbList'. -- -- /Since: 2/ genericShowbList :: (Generic a, GTextShowB Zero (Rep a)) => [a] -> Builder genericShowbList = showbListWith genericShowb -- | A 'Generic' implementation of 'printT'. -- -- /Since: 2/ genericPrintT :: (Generic a, GTextShowT Zero (Rep a)) => a -> IO () genericPrintT = TS.putStrLn . genericShowt -- | A 'Generic' implementation of 'printTL'. -- -- /Since: 2/ genericPrintTL :: (Generic a, GTextShowTL Zero (Rep a)) => a -> IO () genericPrintTL = TL.putStrLn . genericShowtl -- | A 'Generic' implementation of 'hPrintT'. -- -- /Since: 2/ genericHPrintT :: (Generic a, GTextShowT Zero (Rep a)) => Handle -> a -> IO () genericHPrintT h = TS.hPutStrLn h . genericShowt -- | A 'Generic' implementation of 'hPrintTL'. -- -- /Since: 2/ genericHPrintTL :: (Generic a, GTextShowTL Zero (Rep a)) => Handle -> a -> IO () genericHPrintTL h = TL.hPutStrLn h . genericShowtl -- | A 'Generic1' implementation of 'genericLiftShowbPrec'. -- -- /Since: 2/ genericLiftShowbPrec :: (Generic1 f, GTextShowB One (Rep1 f)) => (Int -> a -> Builder) -> ([a] -> Builder) -> Int -> f a -> Builder genericLiftShowbPrec sp sl p = gShowbPrec (Show1FunsB sp sl) p . from1 -- | A 'Generic'/'Generic1' implementation of 'showbPrec1'. -- -- /Since: 2/ genericShowbPrec1 :: ( Generic a, Generic1 f , GTextShowB Zero (Rep a) , GTextShowB One (Rep1 f) ) => Int -> f a -> Builder genericShowbPrec1 = genericLiftShowbPrec genericShowbPrec genericShowbList ------------------------------------------------------------------------------- -- | 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 , Ord , Read , Show , Typeable #if __GLASGOW_HASKELL__ >= 702 , Generic #endif #if __GLASGOW_HASKELL__ >= 800 , Lift #endif ) -- | A type-level indicator that 'TextShow' is being derived generically. -- -- /Since: 3.2/ data Zero -- | A type-level indicator that 'TextShow1' is being derived generically. -- -- /Since: 3.2/ data One {- 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. I suppose I could use TH instead to make this look a little nicer, but I haven't attempted that. -} #if __GLASGOW_HASKELL__ >= 708 #define DERIVE_TYPEABLE(name) deriving instance Typeable name #else #define DERIVE_TYPEABLE(name) #endif #if __GLASGOW_HASKELL__ >= 711 #define HASH_FUNS(text_type,one_hash,two_hash,hash_prec,from_char,from_string) \ one_hash, two_hash :: text_type; \ hash_prec :: Int -> Int; \ one_hash = from_char '#'; \ two_hash = from_string "##"; \ hash_prec = const 0 #else #define HASH_FUNS(text_type,one_hash,two_hash,hash_prec,from_char,from_string) \ one_hash, two_hash :: text_type; \ hash_prec :: Int -> Int; \ one_hash = mempty; \ two_hash = mempty; \ hash_prec = id #endif #define GTEXT_SHOW(text_type,show_funs,no_show_funs,show1_funs,one_hash,two_hash,hash_prec,gtext_show,gshow_prec,gtext_show_con,gshow_prec_con,show_prec,lift_show_prec,show_space,show_paren,show_list_with,from_char,from_string) \ {- | A 'show_funs' value either stores nothing (for 'TextShow') or it stores \ the two function arguments that show occurrences of the type parameter (for \ 'TextShow1'). \ \ /Since: 3.4/ \ -}; \ data show_funs arity a where { \ no_show_funs :: show_funs Zero a \ ; show1_funs :: (Int -> a -> text_type) -> ([a] -> text_type) -> show_funs One a \ } deriving Typeable; \ \ instance Contravariant (show_funs arity) where { \ contramap _ no_show_funs = no_show_funs \ ; contramap f (show1_funs sp sl) = show1_funs (\p -> sp p . f) (sl . map f) \ }; \ \ {- | Class of generic representation types that can be converted to \ a 'text_type'. The @arity@ type variable indicates which type class is \ used. @'gtext_show' 'Zero'@ indicates 'TextShow' behavior, and \ @'gtext_show' 'One'@ indicates 'TextShow1' behavior. \ \ /Since: 3.4/ \ -}; \ class gtext_show arity f where { \ {- | This is used as the default generic implementation of 'show_prec' (if the \ @arity@ is 'Zero') or 'lift_show_prec' (if the @arity@ is 'One'). \ -} \ ; gshow_prec :: show_funs arity a -> Int -> f a -> text_type \ }; \ \ DERIVE_TYPEABLE(gtext_show); \ \ instance gtext_show arity f => gtext_show arity (D1 d f) where { \ gshow_prec sfs p (M1 x) = gshow_prec sfs p x \ }; \ \ instance gtext_show Zero V1 where { \ gshow_prec _ _ !_ = error "Void show_prec" \ }; \ \ instance gtext_show One V1 where { \ gshow_prec _ _ !_ = error "Void lift_show_prec" \ }; \ \ instance (gtext_show arity f, gtext_show arity g) => gtext_show arity (f :+: g) where { \ gshow_prec sfs p (L1 x) = gshow_prec sfs p x \ ; gshow_prec sfs p (R1 x) = gshow_prec sfs p x \ }; \ \ instance (Constructor c, gtext_show_con arity f, IsNullary f) \ => gtext_show arity (C1 c f) where { \ gshow_prec sfs 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 ' ') \ <> showbBraces t (gshow_prec_con t sfs appPrec1 x) \ ; Infix _ m -> show_paren (p > m) $ gshow_prec_con t sfs (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 \ }; \ } \ \ ; showbBraces :: ConType -> text_type -> text_type \ ; showbBraces Rec b = from_char '{' <> b <> from_char '}' \ ; showbBraces Tup b = from_char '(' <> b <> from_char ')' \ ; showbBraces Pref b = b \ ; showbBraces (Inf _) b = b \ \ ; conIsTuple :: C1 c f p -> Bool \ ; conIsTuple = isTupleString . conName \ }; \ }; \ \ {- | Class of generic representation types for which the 'ConType' has been \ determined. The @arity@ type variable indicates which type class is \ used. @'gtext_show_con' 'Zero'@ indicates 'TextShow' behavior, and \ @'gtext_show_con' 'One'@ indicates 'TextShow1' behavior. \ -}; \ class gtext_show_con arity f where { \ {- | Convert value of a specific 'ConType' to a 'text_type' with the given \ precedence. \ -} \ ; gshow_prec_con :: ConType -> show_funs arity a -> Int -> f a -> text_type \ }; \ \ DERIVE_TYPEABLE(gtext_show_con); \ \ instance gtext_show_con arity U1 where { \ gshow_prec_con _ _ _ U1 = mempty \ }; \ \ instance gtext_show_con One Par1 where { \ gshow_prec_con _ (show1_funs sp _) p (Par1 x) = sp p x \ }; \ \ instance TextShow c => gtext_show_con arity (K1 i c) where { \ gshow_prec_con _ _ p (K1 x) = show_prec p x \ }; \ \ instance TextShow1 f => gtext_show_con One (Rec1 f) where { \ gshow_prec_con _ (show1_funs sp sl) p (Rec1 x) = lift_show_prec sp sl p x \ }; \ \ instance (Selector s, gtext_show_con arity f) => gtext_show_con arity (S1 s f) where { \ gshow_prec_con t sfs p sel@(M1 x) \ | selName sel == "" = gshow_prec_con t sfs p x \ | otherwise = infixRec \ <> " = " \ <> gshow_prec_con t sfs 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 \ } \ }; \ \ instance (gtext_show_con arity f, gtext_show_con arity g) \ => gtext_show_con arity (f :*: g) where { \ gshow_prec_con t@Rec sfs _ (a :*: b) = \ gshow_prec_con t sfs 0 a \ <> ", " \ <> gshow_prec_con t sfs 0 b \ ; gshow_prec_con t@(Inf o) sfs p (a :*: b) = \ gshow_prec_con t sfs p a \ <> show_space \ <> infixOp \ <> show_space \ <> gshow_prec_con t sfs p b \ where { \ infixOp :: text_type \ ; infixOp = if isInfixDataCon o \ then from_string o \ else from_char '`' <> from_string o <> from_char '`' \ } \ ; gshow_prec_con t@Tup sfs _ (a :*: b) = \ gshow_prec_con t sfs 0 a \ <> from_char ',' \ <> gshow_prec_con t sfs 0 b \ ; gshow_prec_con t@Pref sfs p (a :*: b) = \ gshow_prec_con t sfs p a \ <> show_space \ <> gshow_prec_con t sfs p b \ }; \ \ instance (TextShow1 f, gtext_show_con One g) => gtext_show_con One (f :.: g) where { \ gshow_prec_con t sfs p (Comp1 x) = \ let gspc = gshow_prec_con t sfs \ in lift_show_prec gspc (show_list_with (gspc 0)) p x \ }; \ \ instance gtext_show_con arity UChar where { \ gshow_prec_con _ _ p (UChar c) = show_prec (hash_prec p) (C# c) <> one_hash \ }; \ \ instance gtext_show_con arity UDouble where { \ gshow_prec_con _ _ p (UDouble d) = show_prec (hash_prec p) (D# d) <> two_hash \ }; \ \ instance gtext_show_con arity UFloat where { \ gshow_prec_con _ _ p (UFloat f) = show_prec (hash_prec p) (F# f) <> one_hash \ }; \ \ instance gtext_show_con arity UInt where { \ gshow_prec_con _ _ p (UInt i) = show_prec (hash_prec p) (I# i) <> one_hash \ }; \ \ instance gtext_show_con arity UWord where { \ gshow_prec_con _ _ p (UWord w) = show_prec (hash_prec p) (W# w) <> two_hash \ }; \ \ HASH_FUNS(text_type,one_hash,two_hash,hash_prec,from_char,from_string); GTEXT_SHOW(Builder,ShowFunsB,NoShowFunsB,Show1FunsB,oneHashB,twoHashB,hashPrecB,GTextShowB,gShowbPrec,GTextShowConB,gShowbPrecCon,showbPrec,liftShowbPrec,showbSpace,showbParen,showbListWith,TB.singleton,TB.fromString) GTEXT_SHOW(TS.Text,ShowFunsT,NoShowFunsT,Show1FunsT,oneHashT,twoHashT,hashPrecT,GTextShowT,gShowtPrec,GTextShowConT,gShowtPrecCon,showtPrec,liftShowtPrec,showtSpace,showtParen,showtListWith,TS.singleton,TS.pack) GTEXT_SHOW(TL.Text,ShowFunsTL,NoShowFunsTL,Show1FunsTL,oneHashTL,twoHashTL,hashPrecTL,GTextShowTL,gShowtlPrec,GTextShowConTL,gShowtlPrecCon,showtlPrec,liftShowtlPrec,showtlSpace,showtlParen,showtlListWith,TL.singleton,TL.pack) -- | 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__ < 702 $(Generics.deriveAll ''ConType) #endif #if __GLASGOW_HASKELL__ < 800 $(deriveLift ''ConType) #endif text-show-3.6/src/TextShow/TH/0000755000000000000000000000000013077013176014406 5ustar0000000000000000text-show-3.6/src/TextShow/TH/Internal.hs0000644000000000000000000022036713077013176016530 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# 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 (liftM, unless, when) #if MIN_VERSION_template_haskell(2,11,0) import Control.Monad ((<=<)) #endif import Data.Foldable.Compat import Data.List.Compat import qualified Data.List.NonEmpty as NE (drop, length, reverse, splitAt) import Data.List.NonEmpty (NonEmpty(..), (<|)) import qualified Data.Map as Map (fromList, findWithDefault, keys, lookup, singleton) import Data.Map (Map) import Data.Maybe import Data.Monoid.Compat ((<>)) import qualified Data.Set as Set import Data.Set (Set) import qualified Data.Text as TS import qualified Data.Text.IO as TS (putStrLn, hPutStrLn) import Data.Text.Lazy (toStrict) import 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(..)) import GHC.Prim (Char#, Double#, Float#, Int#, Word#) import GHC.Show (appPrec, appPrec1) import Language.Haskell.TH.Lib import Language.Haskell.TH.Ppr hiding (appPrec) import Language.Haskell.TH.Syntax import Prelude () import Prelude.Compat import TextShow.Classes (TextShow(..), TextShow1(..), TextShow2(..), showbListWith, showbParen, 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 ... @ If you are using @template-haskell-2.7.0.0@ or later (i.e., GHC 7.4 or later), 'deriveTextShow' can also be used to derive 'TextShow' instances for data family instances (which requires the @-XTypeFamilies@ extension). To do so, pass the name of a data or newtype instance constructor (NOT a data family name!) to 'deriveTextShow'. Note that the generated code may require the @-XFlexibleInstances@ extension. Some examples: @ {-# 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 -- | Generates a lambda expression which behaves like 'showtlPrec' (without -- requiring a 'TextShow' instance). -- -- /Since: 2/ makeShowtlPrec :: Name -> Q Exp makeShowtlPrec = makeShowbPrecClass TextShow ShowtlPrec -- | 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 -- | Generates a lambda expression which behaves like 'liftShowbPrec' (without -- requiring a 'TextShow1' instance). -- -- /Since: 3/ makeLiftShowbPrec :: Name -> Q Exp makeLiftShowbPrec = makeShowbPrecClass TextShow1 ShowbPrec -- | 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 -- | 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 = withType name fromCons where fromCons :: Name -> Cxt -> [TyVarBndr] -> [Con] -> Maybe [Type] -> Q [Dec] fromCons name' ctxt tvbs cons mbTys = (:[]) <$> do (instanceCxt, instanceType) <- buildTypeInstance tsClass name' ctxt tvbs mbTys instanceD (return instanceCxt) (return instanceType) (showbPrecDecs tsClass opts 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 -> [Con] -> [Q Dec] showbPrecDecs tsClass opts 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 cons) [] ] -- | Generates a lambda expression which behaves like showbPrec (for TextShow), -- liftShowbPrec (for TextShow1), or liftShowbPrec2 (for TextShow2). makeShowbPrecClass :: TextShowClass -> TextShowFun -> Name -> Q Exp makeShowbPrecClass tsClass tsFun name = withType name fromCons where fromCons :: Name -> Cxt -> [TyVarBndr] -> [Con] -> Maybe [Type] -> Q Exp fromCons name' ctxt tvbs cons mbTys = -- We force buildTypeInstance here since it performs some checks for whether -- or not the provided datatype can actually have showbPrec/liftShowbPrec/etc. -- implemented for it, and produces errors if it can't. buildTypeInstance tsClass name' ctxt tvbs mbTys `seq` makeTextShowForCons tsClass tsFun cons -- | Generates a lambda expression for showbPrec/liftShowbPrec/etc. for the -- given constructors. All constructors must be from the same type. makeTextShowForCons :: TextShowClass -> TextShowFun -> [Con] -> Q Exp makeTextShowForCons _ _ [] = error "Must have at least one data constructor" makeTextShowForCons tsClass tsFun cons = do p <- newName "p" value <- newName "value" sps <- newNameList "sp" $ fromEnum tsClass sls <- newNameList "sl" $ fromEnum tsClass let spls = zip sps sls spsAndSls = interleave sps sls matches <- concatMapM (makeTextShowForCon p tsClass tsFun spls) cons lamE (map varP $ spsAndSls ++ [p, value]) . appsE $ [ varE $ showPrecConstName tsClass tsFun , caseE (varE value) (map return matches) ] ++ map varE spsAndSls ++ [varE p, varE value] -- | Generates a lambda expression for howbPrec/liftShowbPrec/etc. for a -- single constructor. makeTextShowForCon :: Name -> TextShowClass -> TextShowFun -> [(Name, Name)] -> Con -> Q [Match] makeTextShowForCon _ _ tsFun _ (NormalC conName []) = do m <- match (conP conName []) (normalB $ varE (fromStringName tsFun) `appE` stringE (parenInfixConName conName "")) [] return [m] makeTextShowForCon p tsClass tsFun spls (NormalC conName [_]) = do ([argTy], tvMap) <- reifyConTys tsClass spls conName arg <- newName "arg" let showArg = makeTextShowForArg appPrec1 tsClass tsFun conName tvMap argTy arg namedArg = infixApp (varE (fromStringName tsFun) `appE` stringE (parenInfixConName conName " ")) [| (<>) |] showArg m <- match (conP conName [varP arg]) (normalB $ varE (showParenName tsFun) `appE` infixApp (varE p) [| (>) |] (integerE appPrec) `appE` namedArg) [] return [m] makeTextShowForCon p tsClass tsFun spls (NormalC conName _) = do (argTys, tvMap) <- reifyConTys tsClass spls conName args <- newNameList "arg" $ length argTys m <- if isNonUnitTuple conName then do let showArgs = zipWith (makeTextShowForArg 0 tsClass tsFun conName tvMap) argTys args parenCommaArgs = (varE (singletonName tsFun) `appE` charE '(') : 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) [] return [m] makeTextShowForCon p tsClass tsFun spls (RecC conName []) = makeTextShowForCon p tsClass tsFun spls $ NormalC conName [] makeTextShowForCon p tsClass tsFun spls (RecC conName ts) = do (argTys, tvMap) <- reifyConTys tsClass spls conName 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 ts 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 m <- match (conP conName $ map varP args) (normalB $ varE (showParenName tsFun) `appE` infixApp (varE p) [| (>) |] (integerE appPrec) `appE` namedArgs) [] return [m] makeTextShowForCon p tsClass tsFun spls (InfixC _ conName _) = do ([alTy, arTy], tvMap) <- reifyConTys tsClass spls conName al <- newName "argL" ar <- newName "argR" info <- reify conName #if MIN_VERSION_template_haskell(2,11,0) conPrec <- case info of DataConI{} -> do fi <- fromMaybe defaultFixity <$> reifyFixity conName case fi of Fixity prec _ -> return prec #else let conPrec = case info of DataConI _ _ _ (Fixity prec _) -> prec #endif _ -> error $ "TextShow.TH.makeTextShowForCon: Unsupported type: " ++ show info let opName = nameBase conName infixOpE = appE (varE $ fromStringName tsFun) . stringE $ if isInfixDataCon opName then " " ++ opName ++ " " else " `" ++ opName ++ "` " m <- 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))) ) [] return [m] makeTextShowForCon p tsClass tsFun spls (ForallC _ _ con) = makeTextShowForCon p tsClass tsFun spls con #if MIN_VERSION_template_haskell(2,11,0) makeTextShowForCon p tsClass tsFun spls (GadtC conNames ts _) = let con :: Name -> Q Con con conName = do mbFi <- reifyFixity conName return $ if isInfixDataCon (nameBase conName) && length ts == 2 && isJust mbFi then let [t1, t2] = ts in InfixC t1 conName t2 else NormalC conName ts in concatMapM (makeTextShowForCon p tsClass tsFun spls <=< con) conNames makeTextShowForCon p tsClass tsFun spls (RecGadtC conNames ts _) = concatMapM (makeTextShowForCon p tsClass tsFun spls . flip RecC ts) conNames #endif -- | Generates a lambda expression for howbPrec/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 | tyName == ''Char# = showPrimE 'C# oneHashE | tyName == ''Double# = showPrimE 'D# twoHashE | tyName == ''Float# = showPrimE 'F# oneHashE | tyName == ''Int# = showPrimE 'I# oneHashE | tyName == ''Word# = showPrimE 'W# twoHashE | otherwise = showPrecE `appE` integerE p `appE` tyVarE -- Starting with GHC 7.10, data types containing unlifted types with derived Show -- instances show hashed literals with actual hash signs, and negative hashed -- literals are not surrounded with parentheses. showPrimE :: Name -> Q Exp -> Q Exp showPrimE con _hashE #if __GLASGOW_HASKELL__ >= 711 = infixApp (showPrecE `appE` integerE 0 `appE` (conE con `appE` tyVarE)) [| (<>) |] _hashE #else = showPrecE `appE` integerE p `appE` (conE con `appE` tyVarE) #endif oneHashE, twoHashE :: Q Exp oneHashE = varE (singletonName tsFun) `appE` charE '#' twoHashE = varE (fromStringName tsFun) `appE` stringE "##" makeTextShowForArg p tsClass tsFun conName tvMap ty tyExpName = [| $(makeTextShowForType tsClass tsFun conName tvMap False ty) p $(varE tyExpName) |] -- | Generates a lambda expression for howbPrec/liftShowbPrec/etc. for a -- specific type. The generated expression depends on the number of type variables. -- -- 1. If the type is of kind * (T), apply showbPrec. -- 2. If the type is of kind * -> * (T a), apply liftShowbPrec $(makeTextShowForType a) -- 3. If the type is of kind * -> * -> * (T a b), apply -- liftShowbPrec2 $(makeTextShowForType a) $(makeTextShowForType b) makeTextShowForType :: TextShowClass -> 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 <- isTyFamily tyCon if any (`mentionsName` tyVarNames) lhsArgs || itf && any (`mentionsName` tyVarNames) tyArgs 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 ------------------------------------------------------------------------------- -- | Extracts a plain type constructor's information. -- | Boilerplate for top level splices. -- -- The given Name must meet one of two criteria: -- -- 1. It must be the name of a type constructor of a plain data type or newtype. -- 2. It must be the name of a data family instance or newtype instance constructor. -- -- Any other value will result in an exception. withType :: Name -> (Name -> Cxt -> [TyVarBndr] -> [Con] -> Maybe [Type] -> Q a) -> Q a withType name f = do info <- reify name case info of TyConI dec -> case dec of DataD ctxt _ tvbs #if MIN_VERSION_template_haskell(2,11,0) _ #endif cons _ -> f name ctxt tvbs cons Nothing NewtypeD ctxt _ tvbs #if MIN_VERSION_template_haskell(2,11,0) _ #endif con _ -> f name ctxt tvbs [con] Nothing _ -> error $ ns ++ "Unsupported type: " ++ show dec #if MIN_VERSION_template_haskell(2,7,0) # if MIN_VERSION_template_haskell(2,11,0) DataConI _ _ parentName -> do # else DataConI _ _ parentName _ -> do # endif parentInfo <- reify parentName case parentInfo of # if MIN_VERSION_template_haskell(2,11,0) FamilyI (DataFamilyD _ tvbs _) decs -> # else FamilyI (FamilyD DataFam _ tvbs _) decs -> # endif let instDec = flip find decs $ \dec -> case dec of DataInstD _ _ _ # if MIN_VERSION_template_haskell(2,11,0) _ # endif cons _ -> any ((name ==) . constructorName) cons NewtypeInstD _ _ _ # if MIN_VERSION_template_haskell(2,11,0) _ # endif con _ -> name == constructorName con _ -> error $ ns ++ "Must be a data or newtype instance." in case instDec of Just (DataInstD ctxt _ instTys # if MIN_VERSION_template_haskell(2,11,0) _ # endif cons _) -> f parentName ctxt tvbs cons $ Just instTys Just (NewtypeInstD ctxt _ instTys # if MIN_VERSION_template_haskell(2,11,0) _ # endif con _) -> f parentName ctxt tvbs [con] $ Just instTys _ -> error $ ns ++ "Could not find data or newtype instance constructor." _ -> error $ ns ++ "Data constructor " ++ show name ++ " is not from a data family instance constructor." # if MIN_VERSION_template_haskell(2,11,0) FamilyI DataFamilyD{} _ -> # else FamilyI (FamilyD DataFam _ _ _) _ -> # endif error $ ns ++ "Cannot use a data family name. Use a data family instance constructor instead." _ -> error $ ns ++ "The name must be of a plain data type constructor, " ++ "or a data family instance constructor." #else DataConI{} -> dataConIError _ -> error $ ns ++ "The name must be of a plain type constructor." #endif where ns :: String ns = "TextShow.TH.withType: " -- | Deduces the instance context and head for an instance. buildTypeInstance :: TextShowClass -- ^ TextShow, TextShow1, or TextShow2 -> Name -- ^ The type constructor or data family name -> Cxt -- ^ The datatype context -> [TyVarBndr] -- ^ The type variables from the data type/data family declaration -> Maybe [Type] -- ^ 'Just' the types used to instantiate a data family instance, -- or 'Nothing' if it's a plain data type -> Q (Cxt, Type) -- Plain data type/newtype case buildTypeInstance tsClass tyConName dataCxt tvbs Nothing = let varTys :: [Type] varTys = map tvbToType tvbs in buildTypeInstanceFromTys tsClass tyConName dataCxt varTys False -- Data family instance case -- -- The CPP is present to work around a couple of annoying old GHC bugs. -- See Note [Polykinded data families in Template Haskell] buildTypeInstance tsClass parentName dataCxt tvbs (Just instTysAndKinds) = do #if !(MIN_VERSION_template_haskell(2,8,0)) || MIN_VERSION_template_haskell(2,10,0) let instTys :: [Type] instTys = zipWith stealKindForType tvbs instTysAndKinds #else let kindVarNames :: [Name] kindVarNames = nub $ concatMap (tyVarNamesOfType . tvbKind) tvbs numKindVars :: Int numKindVars = length kindVarNames givenKinds, givenKinds' :: [Kind] givenTys :: [Type] (givenKinds, givenTys) = splitAt numKindVars instTysAndKinds givenKinds' = map sanitizeStars givenKinds -- A GHC 7.6-specific bug requires us to replace all occurrences of -- (ConT GHC.Prim.*) with StarT, or else Template Haskell will reject it. -- Luckily, (ConT GHC.Prim.*) only seems to occur in this one spot. sanitizeStars :: Kind -> Kind sanitizeStars = go where go :: Kind -> Kind go (AppT t1 t2) = AppT (go t1) (go t2) go (SigT t k) = SigT (go t) (go k) go (ConT n) | n == starKindName = StarT go t = t -- It's quite awkward to import * from GHC.Prim, so we'll just -- hack our way around it. starKindName :: Name starKindName = mkNameG_tc "ghc-prim" "GHC.Prim" "*" -- If we run this code with GHC 7.8, we might have to generate extra type -- variables to compensate for any type variables that Template Haskell -- eta-reduced away. -- See Note [Polykinded data families in Template Haskell] xTypeNames <- newNameList "tExtra" (length tvbs - length givenTys) let xTys :: [Type] xTys = map VarT xTypeNames -- ^ Because these type variables were eta-reduced away, we can only -- determine their kind by using stealKindForType. Therefore, we mark -- them as VarT to ensure they will be given an explicit kind annotation -- (and so the kind inference machinery has the right information). substNamesWithKinds :: [(Name, Kind)] -> Type -> Type substNamesWithKinds nks t = foldr' (uncurry substNameWithKind) t nks -- The types from the data family instance might not have explicit kind -- annotations, which the kind machinery needs to work correctly. To -- compensate, we use stealKindForType to explicitly annotate any -- types without kind annotations. instTys :: [Type] instTys = map (substNamesWithKinds (zip kindVarNames givenKinds')) -- ^ Note that due to a GHC 7.8-specific bug -- (see Note [Polykinded data families in Template Haskell]), -- there may be more kind variable names than there are kinds -- to substitute. But this is OK! If a kind is eta-reduced, it -- means that is was not instantiated to something more specific, -- so we need not substitute it. Using stealKindForType will -- grab the correct kind. $ zipWith stealKindForType tvbs (givenTys ++ xTys) #endif buildTypeInstanceFromTys tsClass parentName dataCxt instTys True -- For the given Types, generate an instance context and head. Coming up with -- the instance type isn't as simple as dropping the last types, as you need to -- be wary of kinds being instantiated with *. -- See Note [Type inference in derived instances] buildTypeInstanceFromTys :: TextShowClass -- ^ TextShow, TextShow1, or TextShow2 -> Name -- ^ The type constructor or data family name -> Cxt -- ^ The datatype context -> [Type] -- ^ The types to instantiate the instance with -> Bool -- ^ True if it's a data family, False otherwise -> Q (Cxt, Type) buildTypeInstanceFromTys tsClass tyConName dataCxt varTysOrig isDataFamily = do -- Make sure to expand through type/kind synonyms! Otherwise, the -- eta-reduction check might get tripped up over type variables in a -- synonym that are actually dropped. -- (See GHC Trac #11416 for a scenario where this actually happened.) varTysExp <- mapM expandSyn varTysOrig let remainingLength :: Int remainingLength = length varTysOrig - fromEnum tsClass droppedTysExp :: [Type] droppedTysExp = drop remainingLength varTysExp droppedStarKindStati :: [StarKindStatus] droppedStarKindStati = map canRealizeKindStar droppedTysExp -- Check there are enough types to drop and that all of them are either of -- kind * or kind k (for some kind variable k). If not, throw an error. when (remainingLength < 0 || any (== NotKindStar) droppedStarKindStati) $ derivingKindError tsClass tyConName let droppedKindVarNames :: [Name] droppedKindVarNames = catKindVarNames droppedStarKindStati -- Substitute kind * for any dropped kind variables varTysExpSubst :: [Type] varTysExpSubst = map (substNamesWithKindStar droppedKindVarNames) varTysExp remainingTysExpSubst, droppedTysExpSubst :: [Type] (remainingTysExpSubst, droppedTysExpSubst) = splitAt remainingLength varTysExpSubst -- All of the type variables mentioned in the dropped types -- (post-synonym expansion) droppedTyVarNames :: [Name] droppedTyVarNames = concatMap tyVarNamesOfType droppedTysExpSubst -- If any of the dropped types were polykinded, ensure that 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 (union droppedKindVarNames kvNames')) $ take remainingLength varTysOrig remainingTysOrigSubst' :: [Type] -- See Note [Kind signatures in derived instances] for an explanation -- of the isDataFamily check. remainingTysOrigSubst' = if isDataFamily then remainingTysOrigSubst else map unSigT remainingTysOrigSubst instanceCxt :: Cxt instanceCxt = catMaybes preds instanceType :: Type instanceType = AppT (ConT $ textShowClassName tsClass) $ applyTyCon tyConName remainingTysOrigSubst' -- If the datatype context mentions any of the dropped type variables, -- we can't derive an instance, so throw an error. when (any (`predMentionsName` droppedTyVarNames) dataCxt) $ datatypeContextError tyConName instanceType -- Also ensure the dropped types can be safely eta-reduced. Otherwise, -- throw an error. unless (canEtaReduce remainingTysExpSubst' droppedTysExpSubst) $ etaReductionError instanceType return (instanceCxt, instanceType) -- | Attempt to derive a constraint on a Type. If successful, return -- Just the constraint and any kind variable names constrained to *. -- Otherwise, return Nothing and the empty list. -- -- See Note [Type inference in derived instances] for the heuristics used to -- come up with constraints. deriveConstraint :: TextShowClass -> Type -> (Maybe Pred, [Name]) deriveConstraint tsClass t | not (isTyVar t) = (Nothing, []) | hasKindStar t = (Just (applyClass ''TextShow tName), []) | otherwise = case hasKindVarChain 1 t of Just ns | tsClass >= TextShow1 -> (Just (applyClass ''TextShow1 tName), ns) _ -> case hasKindVarChain 2 t of Just ns | tsClass == TextShow2 -> (Just (applyClass ''TextShow2 tName), ns) _ -> (Nothing, []) where tName :: Name tName = varTToName t {- Note [Polykinded data families in Template Haskell] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In order to come up with the correct instance context and head for an instance, e.g., instance C a => C (Data a) where ... We need to know the exact types and kinds used to instantiate the instance. For plain old datatypes, this is simple: every type must be a type variable, and Template Haskell reliably tells us the type variables and their kinds. Doing the same for data families proves to be much harder for three reasons: 1. On any version of Template Haskell, it may not tell you what an instantiated type's kind is. For instance, in the following data family instance: data family Fam (f :: * -> *) (a :: *) data instance Fam f a Then if we use TH's reify function, it would tell us the TyVarBndrs of the data family declaration are: [KindedTV f (AppT (AppT ArrowT StarT) StarT),KindedTV a StarT] and the instantiated types of the data family instance are: [VarT f1,VarT a1] We can't just pass [VarT f1,VarT a1] to buildTypeInstanceFromTys, since we have no way of knowing their kinds. Luckily, the TyVarBndrs tell us what the kind is in case an instantiated type isn't a SigT, so we use the stealKindForType function to ensure all of the instantiated types are SigTs before passing them to buildTypeInstanceFromTys. 2. On GHC 7.6 and 7.8, a bug is present in which Template Haskell lists all of the specified kinds of a data family instance efore any of the instantiated types. Fortunately, this is easy to deal with: you simply count the number of distinct kind variables in the data family declaration, take that many elements from the front of the Types list of the data family instance, substitute the kind variables with their respective instantiated kinds (which you took earlier), and proceed as normal. 3. On GHC 7.8, an even uglier bug is present (GHC Trac #9692) in which Template Haskell might not even list all of the Types of a data family instance, since they are eta-reduced away! And yes, kinds can be eta-reduced too. The simplest workaround is to count how many instantiated types are missing from the list and generate extra type variables to use in their place. Luckily, we needn't worry much if its kind was eta-reduced away, since using stealKindForType will get it back. Note [Kind signatures in derived instances] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It is possible to put explicit kind signatures into the derived instances, e.g., instance C a => C (Data (f :: * -> *)) where ... But it is preferable to avoid this if possible. If we come up with an incorrect kind signature (which is entirely possible, since our type inferencer is pretty unsophisticated - see Note [Type inference in derived instances]), then GHC will flat-out reject the instance, which is quite unfortunate. Plain old datatypes have the advantage that you can avoid using any kind signatures at all in their instances. This is because a datatype declaration uses all type variables, so the types that we use in a derived instance uniquely determine their kinds. As long as we plug in the right types, the kind inferencer can do the rest of the work. For this reason, we use unSigT to remove all kind signatures before splicing in the instance context and head. Data family instances are trickier, since a data family can have two instances that are distinguished by kind alone, e.g., data family Fam (a :: k) data instance Fam (a :: * -> *) data instance Fam (a :: *) If we dropped the kind signatures for C (Fam a), then GHC will have no way of knowing which instance we are talking about. To avoid this scenario, we always include explicit kind signatures in data family instances. There is a chance that the inferred kind signatures will be incorrect, but if so, we can always fall back on the make- functions. Note [Type inference in derived instances] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Type inference is can be tricky to get right, and we want to avoid recreating the entirety of GHC's type inferencer in Template Haskell. For this reason, we will probably never come up with derived instance contexts that are as accurate as GHC's. But that doesn't mean we can't do anything! There are a couple of simple things we can do to make instance contexts that work for 80% of use cases: 1. If one of the last type parameters is polykinded, then its kind will be specialized to * in the derived instance. We note what kind variable the type parameter had and substitute it with * in the other types as well. For example, imagine you had data Data (a :: k) (b :: k) Then you'd want to derived instance to be: instance C (Data (a :: *)) Not: instance C (Data (a :: k)) 2. We naïvely come up with instance constraints using the following criteria: (i) If there's a type parameter n of kind *, generate a TextShow n constraint. (ii) If there's a type parameter n of kind k1 -> k2 (where k1/k2 are * or kind variables), then generate a TextShow1 n constraint, and if k1/k2 are kind variables, then substitute k1/k2 with * elsewhere in the types. We must consider the case where they are kind variables because you might have a scenario like this: newtype Compose (f :: k2 -> *) (g :: k1 -> k2) (a :: k1) = Compose (f (g a)) Which would have a derived TextShow1 instance of: instance (TextShow1 f, TextShow1 g) => TextShow1 (Compose f g) where ... (iii) If there's a type parameter n of kind k1 -> k2 -> k3 (where k1/k2/k3 are * or kind variables), then generate a TextShow2 constraint and perform kind substitution as in the other cases. -} ------------------------------------------------------------------------------- -- Error messages ------------------------------------------------------------------------------- -- | Either the given data type doesn't have enough type variables, or one of -- the type variables to be eta-reduced cannot realize kind *. derivingKindError :: TextShowClass -> Name -> a derivingKindError tsClass tyConName = error . showString "Cannot derive well-kinded instance of form ‘" . showString className . showChar ' ' . showParen True ( showString (nameBase tyConName) . showString " ..." ) . showString "‘\n\tClass " . showString className . showString " expects an argument of kind " . showString (pprint . createKindChain $ fromEnum tsClass) $ "" where className :: String className = nameBase $ textShowClassName tsClass -- | One of the last type variables cannot be eta-reduced (see the canEtaReduce -- function for the criteria it would have to meet). etaReductionError :: Type -> a etaReductionError instanceType = error $ "Cannot eta-reduce to an instance of form \n\tinstance (...) => " ++ pprint instanceType -- | The data type has a DatatypeContext which mentions one of the eta-reduced -- type variables. datatypeContextError :: Name -> Type -> a datatypeContextError dataName instanceType = error . showString "Can't make a derived instance of ‘" . showString (pprint instanceType) . showString "‘:\n\tData type ‘" . showString (nameBase dataName) . showString "‘ must not have a class context involving the last type argument(s)" $ "" -- | The data type mentions one of the n eta-reduced type variables in a place other -- than the last nth positions of a data type in a constructor's field. outOfPlaceTyVarError :: TextShowClass -> Name -> a outOfPlaceTyVarError tsClass conName = error . showString "Constructor ‘" . showString (nameBase conName) . showString "‘ must only use its last " . shows n . showString " type variable(s) within the last " . shows n . showString " argument(s) of a data type" $ "" where n :: Int n = fromEnum tsClass #if !(MIN_VERSION_template_haskell(2,7,0)) -- | Template Haskell didn't list all of a data family's instances upon reification -- until template-haskell-2.7.0.0, which is necessary for a derived TextShow(1)(2) -- instance to work. dataConIError :: a dataConIError = error . showString "Cannot use a data constructor." . showString "\n\t(Note: if you are trying to derive TextShow for a" . showString "\n\ttype family, use GHC >= 7.4 instead.)" $ "" #endif ------------------------------------------------------------------------------- -- Expanding type synonyms ------------------------------------------------------------------------------- -- | Expands all type synonyms in a type. Written by Dan Rosén in the -- @genifunctors@ package (licensed under BSD3). expandSyn :: Type -> Q Type expandSyn (ForallT tvs ctx t) = fmap (ForallT tvs ctx) $ expandSyn t expandSyn t@AppT{} = expandSynApp t [] expandSyn t@ConT{} = expandSynApp t [] expandSyn (SigT t k) = do t' <- expandSyn t k' <- expandSynKind k return (SigT t' k') expandSyn t = return t expandSynKind :: Kind -> Q Kind #if MIN_VERSION_template_haskell(2,8,0) expandSynKind = expandSyn #else expandSynKind = return -- There are no kind synonyms to deal with #endif expandSynApp :: Type -> [Type] -> Q Type expandSynApp (AppT t1 t2) ts = do t2' <- expandSyn t2 expandSynApp t1 (t2':ts) expandSynApp (ConT n) ts | nameBase n == "[]" = return $ foldl' AppT ListT ts expandSynApp t@(ConT n) ts = do info <- reify n case info of TyConI (TySynD _ tvs rhs) -> let (ts', ts'') = splitAt (length tvs) ts subs = mkSubst tvs ts' rhs' = substType subs rhs in expandSynApp rhs' ts'' _ -> return $ foldl' AppT t ts expandSynApp t ts = do t' <- expandSyn t return $ foldl' AppT t' ts type TypeSubst = Map Name Type type KindSubst = Map Name Kind mkSubst :: [TyVarBndr] -> [Type] -> TypeSubst mkSubst vs ts = let vs' = map un vs un (PlainTV v) = v un (KindedTV v _) = v in Map.fromList $ zip vs' ts substType :: TypeSubst -> Type -> Type substType subs (ForallT v c t) = ForallT v c $ substType subs t substType subs t@(VarT n) = Map.findWithDefault t n subs substType subs (AppT t1 t2) = AppT (substType subs t1) (substType subs t2) substType subs (SigT t k) = SigT (substType subs t) #if MIN_VERSION_template_haskell(2,8,0) (substType subs k) #else k #endif substType _ t = t substKind :: KindSubst -> Type -> Type #if MIN_VERSION_template_haskell(2,8,0) substKind = substType #else substKind _ = id -- There are no kind variables! #endif substNameWithKind :: Name -> Kind -> Type -> Type substNameWithKind n k = substKind (Map.singleton n k) substNamesWithKindStar :: [Name] -> Type -> Type substNamesWithKindStar ns t = foldr' (flip substNameWithKind starK) t ns ------------------------------------------------------------------------------- -- Class-specific constants ------------------------------------------------------------------------------- -- | A representation of which TextShow variant is being derived. data TextShowClass = TextShow | TextShow1 | TextShow2 deriving (Enum, Eq, Ord) -- | 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 #if MIN_VERSION_template_haskell(2,8,0) SigT _ (VarT k) -> IsKindVar k #endif _ -> NotKindStar -- | Returns 'Just' the kind variable 'Name' of a 'StarKindStatus' if it exists. -- Otherwise, returns 'Nothing'. starKindStatusToName :: StarKindStatus -> Maybe Name starKindStatusToName (IsKindVar n) = Just n starKindStatusToName _ = Nothing -- | Concat together all of the StarKindStatuses that are IsKindVar and extract -- the kind variables' Names out. catKindVarNames :: [StarKindStatus] -> [Name] catKindVarNames = mapMaybe starKindStatusToName ------------------------------------------------------------------------------- -- Assorted utilities ------------------------------------------------------------------------------- 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 #if MIN_VERSION_template_haskell(2,8,0) hasKindStar (SigT _ StarT) = True #else hasKindStar (SigT _ StarK) = True #endif hasKindStar _ = False -- Returns True is a kind is equal to *, or if it is a kind variable. isStarOrVar :: Kind -> Bool #if MIN_VERSION_template_haskell(2,8,0) isStarOrVar StarT = True isStarOrVar VarT{} = True #else isStarOrVar StarK = True #endif isStarOrVar _ = False -- Generate a list of fresh names with a common prefix, and numbered suffixes. newNameList :: String -> Int -> Q [Name] newNameList prefix n = mapM (newName . (prefix ++) . show) [1..n] -- | Gets all of the type/kind variable names mentioned somewhere in a Type. tyVarNamesOfType :: Type -> [Name] tyVarNamesOfType = go where go :: Type -> [Name] go (AppT t1 t2) = go t1 ++ go t2 go (SigT t _k) = go t #if MIN_VERSION_template_haskell(2,8,0) ++ go _k #endif go (VarT n) = [n] go _ = [] -- | Gets all of the type/kind variable names mentioned somewhere in a Kind. tyVarNamesOfKind :: Kind -> [Name] #if MIN_VERSION_template_haskell(2,8,0) tyVarNamesOfKind = tyVarNamesOfType #else tyVarNamesOfKind _ = [] -- There are no kind variables #endif -- | @hasKindVarChain n kind@ Checks if @kind@ is of the form -- k_0 -> k_1 -> ... -> k_(n-1), where k0, k1, ..., and k_(n-1) can be * or -- kind variables. hasKindVarChain :: Int -> Type -> Maybe [Name] hasKindVarChain kindArrows t = let uk = uncurryKind (tyKind t) in if (length uk - 1 == kindArrows) && all isStarOrVar uk then Just (concatMap tyVarNamesOfKind uk) else Nothing -- | If a Type is a SigT, returns its kind signature. Otherwise, return *. tyKind :: Type -> Kind tyKind (SigT _ k) = k tyKind _ = starK -- | If a VarT is missing an explicit kind signature, steal it from a TyVarBndr. stealKindForType :: TyVarBndr -> Type -> Type stealKindForType tvb t@VarT{} = SigT t (tvbKind tvb) stealKindForType _ t = t -- | Monadic version of concatMap concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b] concatMapM f xs = liftM concat (mapM f xs) -- | A mapping of type variable Names to their show function Names. For example, in a -- TextShow2 declaration, a TyVarMap might look like (a ~> sp1, b ~> sp2), where -- a and b are the last two type variables of the datatype, and sp1 and sp2 are the two -- functions which show their respective type variables. type TyVarMap = Map Name (Name, Name) -- | Checks if a 'Name' represents a tuple type constructor (other than '()') isNonUnitTuple :: Name -> Bool isNonUnitTuple = isTupleString . nameBase -- | Parenthesize an infix constructor name if it is being applied as a prefix -- function (e.g., data Amp a = (:&) a a) parenInfixConName :: Name -> ShowS parenInfixConName conName = let conNameBase = nameBase conName in showParen (isInfixDataCon conNameBase) $ showString conNameBase -- | Extracts the kind from a TyVarBndr. tvbKind :: TyVarBndr -> Kind tvbKind (PlainTV _) = starK tvbKind (KindedTV _ k) = k -- | Convert a TyVarBndr to a Type. tvbToType :: TyVarBndr -> Type tvbToType (PlainTV n) = VarT n tvbToType (KindedTV n k) = SigT (VarT n) k -- | Applies a typeclass constraint to a type. applyClass :: Name -> Name -> Pred #if MIN_VERSION_template_haskell(2,10,0) applyClass con t = AppT (ConT con) (VarT t) #else applyClass con t = ClassP con [VarT t] #endif -- | Checks to see if the last types in a data family instance can be safely eta- -- reduced (i.e., dropped), given the other types. This checks for three conditions: -- -- (1) All of the dropped types are type variables -- (2) All of the dropped types are distinct -- (3) None of the remaining types mention any of the dropped types canEtaReduce :: [Type] -> [Type] -> Bool canEtaReduce remaining dropped = all isTyVar dropped && allDistinct droppedNames -- Make sure not to pass something of type [Type], since Type -- didn't have an Ord instance until template-haskell-2.10.0.0 && not (any (`mentionsName` droppedNames) remaining) where droppedNames :: [Name] droppedNames = map varTToName dropped -- | Extract Just the Name from a type variable. If the argument Type is not a -- type variable, return Nothing. varTToName_maybe :: Type -> Maybe Name varTToName_maybe (VarT n) = Just n varTToName_maybe (SigT t _) = varTToName_maybe t varTToName_maybe _ = Nothing -- | Extract the Name from a type variable. If the argument Type is not a -- type variable, throw an error. varTToName :: Type -> Name varTToName = fromMaybe (error "Not a type variable!") . varTToName_maybe -- | Peel off a kind signature from a Type (if it has one). unSigT :: Type -> Type unSigT (SigT t _) = t unSigT t = t -- | Is the given type a variable? isTyVar :: Type -> Bool isTyVar (VarT _) = True isTyVar (SigT t _) = isTyVar t isTyVar _ = False -- | Is the given type a type family constructor (and not a data family constructor)? isTyFamily :: Type -> Q Bool isTyFamily (ConT n) = do info <- reify n return $ case info of #if MIN_VERSION_template_haskell(2,11,0) FamilyI OpenTypeFamilyD{} _ -> True #elif MIN_VERSION_template_haskell(2,7,0) FamilyI (FamilyD TypeFam _ _ _) _ -> True #else TyConI (FamilyD TypeFam _ _ _) -> True #endif #if MIN_VERSION_template_haskell(2,9,0) FamilyI ClosedTypeFamilyD{} _ -> True #endif _ -> False isTyFamily _ = return False -- | Are all of the items in a list (which have an ordering) distinct? -- -- This uses Set (as opposed to nub) for better asymptotic time complexity. allDistinct :: Ord a => [a] -> Bool allDistinct = allDistinct' Set.empty where allDistinct' :: Ord a => Set a -> [a] -> Bool allDistinct' uniqs (x:xs) | x `Set.member` uniqs = False | otherwise = allDistinct' (Set.insert x uniqs) xs allDistinct' _ _ = True -- | Does the given type mention any of the Names in the list? mentionsName :: Type -> [Name] -> Bool mentionsName = go where go :: Type -> [Name] -> Bool go (AppT t1 t2) names = go t1 names || go t2 names go (SigT t _k) names = go t names #if MIN_VERSION_template_haskell(2,8,0) || go _k names #endif go (VarT n) names = n `elem` names go _ _ = False -- | Does an instance predicate mention any of the Names in the list? predMentionsName :: Pred -> [Name] -> Bool #if MIN_VERSION_template_haskell(2,10,0) predMentionsName = mentionsName #else predMentionsName (ClassP n tys) names = n `elem` names || any (`mentionsName` names) tys predMentionsName (EqualP t1 t2) names = mentionsName t1 names || mentionsName t2 names #endif -- | Construct a type via curried application. applyTy :: Type -> [Type] -> Type applyTy = foldl' AppT -- | Fully applies a type constructor to its type variables. applyTyCon :: Name -> [Type] -> Type applyTyCon = applyTy . ConT -- | Split an applied type into its individual components. For example, this: -- -- @ -- Either Int Char -- @ -- -- would split to this: -- -- @ -- [Either, Int, Char] -- @ unapplyTy :: Type -> NonEmpty Type unapplyTy = NE.reverse . go where go :: Type -> NonEmpty Type go (AppT t1 t2) = t2 <| go t1 go (SigT t _) = go t go (ForallT _ _ t) = go t go t = t :| [] -- | Split a type signature by the arrows on its spine. For example, this: -- -- @ -- (Int -> String) -> Char -> () -- @ -- -- would split to this: -- -- @ -- [Int -> String, Char, ()] -- @ uncurryTy :: Type -> NonEmpty Type uncurryTy (AppT (AppT ArrowT t1) t2) = t1 <| uncurryTy t2 uncurryTy (SigT t _) = uncurryTy t uncurryTy (ForallT _ _ t) = uncurryTy t uncurryTy t = t :| [] -- | Like uncurryType, except on a kind level. uncurryKind :: Kind -> NonEmpty Kind #if MIN_VERSION_template_haskell(2,8,0) uncurryKind = uncurryTy #else uncurryKind (ArrowK k1 k2) = k1 <| uncurryKind k2 uncurryKind k = k :| [] #endif createKindChain :: Int -> Kind createKindChain = go starK where go :: Kind -> Int -> Kind go k !0 = k #if MIN_VERSION_template_haskell(2,8,0) go k !n = go (AppT (AppT ArrowT StarT) k) (n - 1) #else go k !n = go (ArrowK StarK k) (n - 1) #endif #if MIN_VERSION_template_haskell(2,7,0) -- | Extracts the name of a constructor. constructorName :: Con -> Name constructorName (NormalC name _ ) = name constructorName (RecC name _ ) = name constructorName (InfixC _ name _ ) = name constructorName (ForallC _ _ con) = constructorName con # if MIN_VERSION_template_haskell(2,11,0) constructorName (GadtC names _ _) = head names constructorName (RecGadtC names _ _) = head names # endif #endif isNullaryCon :: Con -> Bool isNullaryCon (NormalC _ []) = True isNullaryCon (RecC _ []) = True isNullaryCon InfixC{} = False isNullaryCon (ForallC _ _ con) = isNullaryCon con #if MIN_VERSION_template_haskell(2,11,0) isNullaryCon (GadtC _ [] _) = True isNullaryCon (RecGadtC _ [] _) = True #endif isNullaryCon _ = False interleave :: [a] -> [a] -> [a] interleave (a1:a1s) (a2:a2s) = a1:a2:interleave a1s a2s interleave _ _ = [] -- Determines the types of a constructor's arguments as well as the last type -- parameters (mapped to their show functions), expanding through any type synonyms. -- The type parameters are determined on a constructor-by-constructor basis since -- they may be refined to be particular types in a GADT. reifyConTys :: TextShowClass -> [(Name, Name)] -> Name -> Q ([Type], TyVarMap) reifyConTys tsClass spls conName = do info <- reify conName uncTy <- case info of DataConI _ ty _ #if !(MIN_VERSION_template_haskell(2,11,0)) _ #endif -> fmap uncurryTy (expandSyn ty) _ -> error "Must be a data constructor" let (argTys, [resTy]) = NE.splitAt (length uncTy - 1) uncTy unapResTy = unapplyTy resTy -- If one of the last type variables is refined to a particular type -- (i.e., not truly polymorphic), we mark it with Nothing and filter -- it out later, since we only apply show functions to arguments of -- a type that it (1) one of the last type variables, and (2) -- of a truly polymorphic type. mbTvNames = map varTToName_maybe $ NE.drop (NE.length unapResTy - fromEnum tsClass) unapResTy -- We use Map.fromList to ensure that if there are any duplicate type -- variables (as can happen in a GADT), the rightmost type variable gets -- associated with the show function. -- -- See Note [Matching functions with GADT type variables] tvMap = Map.fromList . catMaybes -- Drop refined types $ zipWith (\mbTvName sp -> fmap (\tvName -> (tvName, sp)) mbTvName) mbTvNames spls return (argTys, tvMap) {- Note [Matching functions with GADT type variables] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When deriving TextShow2, there is a tricky corner case to consider: data Both a b where BothCon :: x -> x -> Both x x Which show functions should be applied to which arguments of BothCon? We have a choice, since both the function of type (Int -> a -> Builder) and of type (Int -> b -> Builder) can be applied to either argument. In such a scenario, the second show function takes precedence over the first show function, so the derived TextShow2 instance would be: instance TextShow Both where liftShowsPrec2 sp1 sp2 p (BothCon x1 x2) = showbParen (p > appPrec) $ "BothCon " <> sp2 appPrec1 x1 <> showbSpace <> sp2 appPrec1 x2 This is not an arbitrary choice, as this definition ensures that liftShowsPrec2 showsPrec = liftShowsPrec for a derived TextShow1 instance for Both. -} text-show-3.6/src/TextShow/GHC/0000755000000000000000000000000013077013176014474 5ustar0000000000000000text-show-3.6/src/TextShow/GHC/StaticPtr.hs0000644000000000000000000000141013077013176016741 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.6/src/TextShow/GHC/Fingerprint.hs0000644000000000000000000000203413077013176017316 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,4,0) {-# OPTIONS_GHC -fno-warn-orphans #-} #endif {-| 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'. Only provided if using @base-4.4.0.0@ or later. /Since: 2/ -} module TextShow.GHC.Fingerprint () where #if MIN_VERSION_base(4,4,0) import Data.Monoid.Compat ((<>)) import Data.Semigroup (mtimesDefault) import Data.Text.Lazy.Builder (Builder, singleton) import Data.Word (Word64) import GHC.Fingerprint.Type (Fingerprint(..)) import TextShow.Classes (TextShow(..)) 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 #endif text-show-3.6/src/TextShow/GHC/Generics.hs0000644000000000000000000001302413077013176016567 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) #if !(MIN_VERSION_template_haskell(2,7,0)) import Data.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (singleton) import GHC.Exts (Char(C#), Double(D#), Float(F#), Int(I#), Word(W#)) import GHC.Show (appPrec) import TextShow.Classes (showbParen) #endif -- | /Since: 2/ instance TextShow (U1 p) where showbPrec = liftShowbPrec undefined undefined -- | /Since: 2/ $(deriveTextShow1 ''U1) -- | /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 ''(:.:)) #if MIN_VERSION_template_haskell(2,7,0) -- | /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) #else -- | /Since: 2.1.2/ instance TextShow (UChar p) where showbPrec = liftShowbPrec undefined undefined -- | /Since: 2.1.2/ instance TextShow1 UChar where liftShowbPrec _ _ p (UChar c) = showbParen (p > appPrec) $ "UChar " <> singleton '{' <> "uChar# = " <> showb (C# c) <> singleton '}' -- | /Since: 2.1.2/ instance TextShow (UDouble p) where showbPrec = liftShowbPrec undefined undefined -- | /Since: 2.1.2/ instance TextShow1 UDouble where liftShowbPrec _ _ p (UDouble d) = showbParen (p > appPrec) $ "UDouble " <> singleton '{' <> "uDouble# = " <> showb (D# d) <> singleton '}' -- | /Since: 2.1.2/ instance TextShow (UFloat p) where showbPrec = liftShowbPrec undefined undefined -- | /Since: 2.1.2/ instance TextShow1 UFloat where liftShowbPrec _ _ p (UFloat f) = showbParen (p > appPrec) $ "UFloat " <> singleton '{' <> "uFloat# = " <> showb (F# f) <> singleton '}' -- | /Since: 2.1.2/ instance TextShow (UInt p) where showbPrec = liftShowbPrec undefined undefined -- | /Since: 2.1.2/ instance TextShow1 UInt where liftShowbPrec _ _ p (UInt i) = showbParen (p > appPrec) $ "UInt " <> singleton '{' <> "uInt# = " <> showb (I# i) <> singleton '}' -- | /Since: 2.1.2/ instance TextShow (UWord p) where showbPrec = liftShowbPrec undefined undefined -- | /Since: 2.1.2/ instance TextShow1 UWord where liftShowbPrec _ _ p (UWord w) = showbParen (p > appPrec) $ "UWord " <> singleton '{' <> "uWord# = " <> showb (W# w) <> singleton '}' #endif -- | /Since: 2/ $(deriveTextShow ''Fixity) -- | /Since: 2/ $(deriveTextShow ''Associativity) #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.6/src/TextShow/GHC/Stack.hs0000644000000000000000000000215713077013176016102 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) # 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 -- | /Since: 3.0.1/ $(deriveTextShow ''SrcLoc) #endif text-show-3.6/src/TextShow/GHC/Event.hs0000644000000000000000000000407013077013176016112 0ustar0000000000000000{-# LANGUAGE CPP #-} #if !defined(__GHCJS__) && !defined(mingw32_HOST_OS) && MIN_VERSION_base(4,4,0) {-# 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 @base-4.4.0.0@ on a platform other than Windows or GHCJS. /Since: 2/ -} module TextShow.GHC.Event () where #if !defined(__GHCJS__) && !defined(mingw32_HOST_OS) && MIN_VERSION_base(4,4,0) import Data.List (intersperse) import Data.Maybe (catMaybes) import Data.Monoid.Compat ((<>)) 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.6/src/TextShow/GHC/TypeLits.hs0000644000000000000000000000426113077013176016610 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,6,0) # if !(MIN_VERSION_base(4,7,0)) {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE UndecidableInstances #-} # endif {-# OPTIONS_GHC -fno-warn-orphans #-} #endif {-| 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. Only provided if using @base-4.6.0.0@ or later. /Since: 2/ -} module TextShow.GHC.TypeLits () where #if MIN_VERSION_base(4,6,0) import TextShow.Classes (TextShow(..)) import TextShow.Data.Integral () # if MIN_VERSION_base(4,7,0) import GHC.TypeLits (SomeNat(..), SomeSymbol(..), natVal, symbolVal) import TextShow.Data.Char () # else import Data.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (singleton) import GHC.TypeLits (IsEven(..), IsZero(..), Kind, Sing, SingE(fromSing)) # endif # if MIN_VERSION_base(4,7,0) -- | Only available with @base-4.7.0.0@ or later. -- -- /Since: 2/ instance TextShow SomeNat where showbPrec p (SomeNat x) = showbPrec p $ natVal x {-# INLINE showbPrec #-} -- | Only available with @base-4.7.0.0@ or later. -- -- /Since: 2/ instance TextShow SomeSymbol where showb (SomeSymbol x) = showbList $ symbolVal x {-# INLINE showb #-} # else -- | Only available with @base-4.6@. -- -- /Since: 2/ instance TextShow (IsEven n) where showb IsEvenZero = singleton '0' showb (IsEven x) = "(2 * " <> showb x <> singleton ')' showb (IsOdd x) = "(2 * " <> showb x <> " + 1)" {-# INLINE showb #-} -- | Only available with @base-4.6@. -- -- /Since: 2/ instance TextShow (IsZero n) where showb IsZero = singleton '0' showb (IsSucc n) = singleton '(' <> showb n <> " + 1)" {-# INLINE showb #-} -- | Only available with @base-4.6@. -- -- /Since: 2/ instance (SingE (Kind :: k) rep, TextShow rep) => TextShow (Sing (a :: k)) where showbPrec p = showbPrec p . fromSing {-# INLINE showbPrec #-} # endif #endif text-show-3.6/src/TextShow/GHC/Stats.hs0000644000000000000000000000132613077013176016130 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,5,0) {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-deprecations #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #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'. Only provided if using @base-4.5.0.0@ or later. /Since: 2/ -} module TextShow.GHC.Stats () where #if MIN_VERSION_base(4,5,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.6/src/TextShow/GHC/RTS/0000755000000000000000000000000013077013176015144 5ustar0000000000000000text-show-3.6/src/TextShow/GHC/RTS/Flags.hs0000644000000000000000000000326413077013176016541 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/ $(deriveTextShow ''RTSFlags) -- | /Since: 2/ $(deriveTextShow ''GCFlags) -- | /Since: 2/ $(deriveTextShow ''ConcFlags) -- | /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.1/ $(deriveTextShow giveGCStatsTypeName) -- | /Since: 2.1/ $(deriveTextShow doCostCentresTypeName) -- | /Since: 2.1/ $(deriveTextShow doHeapProfileTypeName) -- | /Since: 2.1/ $(deriveTextShow doTraceTypeName) #endif text-show-3.6/src/TextShow/GHC/Conc/0000755000000000000000000000000013077013176015356 5ustar0000000000000000text-show-3.6/src/TextShow/GHC/Conc/Windows.hs0000644000000000000000000000127613077013176017352 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.6/src/TextShow/Text/0000755000000000000000000000000013077013176015017 5ustar0000000000000000text-show-3.6/src/TextShow/Text/Read.hs0000644000000000000000000000164413077013176016233 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# 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) 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) #if MIN_VERSION_base(4,6,0) import TextShow.TH.Names (numberTypeName) #endif -- | /Since: 2/ $(deriveTextShow ''Lexeme) #if MIN_VERSION_base(4,6,0) -- | Only available with @base-4.6.0.0@ or later. -- -- /Since: 2/ $(deriveTextShow numberTypeName) #endif text-show-3.6/src/TextShow/Control/0000755000000000000000000000000013077013176015513 5ustar0000000000000000text-show-3.6/src/TextShow/Control/Applicative.hs0000644000000000000000000000260613077013176020314 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif {-# 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.6/src/TextShow/Control/Concurrent.hs0000644000000000000000000000243513077013176020175 0ustar0000000000000000{-# 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.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (fromString) import Foreign.C.Types import GHC.Conc (BlockReason, ThreadStatus) import GHC.Conc.Sync (ThreadId(..)) import GHC.Prim import TextShow.Classes (TextShow(..)) import TextShow.Foreign.C.Types () import TextShow.TH.Internal (deriveTextShow) -- | /Since: 2/ instance TextShow ThreadId where showbPrec p t = 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 ''ThreadStatus) -- | /Since: 2/ $(deriveTextShow ''BlockReason) text-show-3.6/src/TextShow/Control/Exception.hs0000644000000000000000000001144613077013176020013 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# 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.Monoid.Compat ((<>)) 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/ instance TextShow SomeException where showbPrec p (SomeException e) = showbPrec p $ FromStringShow e {-# INLINE showbPrec #-} -- | /Since: 2/ instance TextShow IOException where showb = showb . FromStringShow {-# INLINE showb #-} -- | /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" #if MIN_VERSION_base(4,6,0) showb RatioZeroDenominator = "Ratio has zero denominator" #endif -- | /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 #-} #if MIN_VERSION_base(4,7,0) -- | Only available with @base-4.7.0.0@ or later. -- -- /Since: 2/ instance TextShow SomeAsyncException where showb (SomeAsyncException e) = showb $ FromStringShow e {-# INLINE showb #-} #endif -- | /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 -- | /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.6/src/TextShow/Control/Monad/0000755000000000000000000000000013077013176016551 5ustar0000000000000000text-show-3.6/src/TextShow/Control/Monad/ST.hs0000644000000000000000000000152013077013176017431 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.6/src/TextShow/Data/0000755000000000000000000000000013077013176014744 5ustar0000000000000000text-show-3.6/src/TextShow/Data/Floating.hs0000644000000000000000000003267413077013176017057 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 Data.Monoid.Compat ((<>)) 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 TextShow.Classes (TextShow(..), showbParen) import TextShow.TH.Internal (deriveTextShow) import TextShow.Utils (i2d) -- | 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 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') = map i2d (if ei > 0 then init is' else is') 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' = map i2d (if ei > 0 then is' else 0:is') 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]) #if MIN_VERSION_base(4,6,0) 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 #else roundTo d is = case f d is of x@(0,_) -> x (1,xs) -> (1, 1:xs) _ -> error "roundTo: bad Value" where f n [] = (0, replicate n 0) f 0 (x:_) = (if x >= 5 then 1 else 0, []) f n (i:xs) | i' == 10 = (1,0:ds) | otherwise = (0,i':ds) where (c,ds) = f (n-1) xs i' = c + i #endif -- 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]] ------------------------------------------------------------------------------- -- TextShow instances ------------------------------------------------------------------------------- -- | /Since: 2/ instance TextShow Float where showbPrec = showbRealFloatPrec {-# INLINE showbPrec #-} -- | /Since: 2/ instance TextShow Double where showbPrec = showbRealFloatPrec {-# INLINE showbPrec #-} -- | /Since: 2/ $(deriveTextShow ''FPFormat) text-show-3.6/src/TextShow/Data/Tuple.hs0000644000000000000000000000473613077013176016403 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# 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 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 ''(,,,,,,,,,,,,,,)) text-show-3.6/src/TextShow/Data/Bool.hs0000644000000000000000000000065413077013176016200 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.6/src/TextShow/Data/Ord.hs0000644000000000000000000000107313077013176016025 0ustar0000000000000000{-# 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.TH.Internal (deriveTextShow, deriveTextShow1) -- | /Since: 2/ $(deriveTextShow ''Ordering) -- | /Since: 2/ $(deriveTextShow ''Down) -- | /Since: 2/ $(deriveTextShow1 ''Down) text-show-3.6/src/TextShow/Data/Ratio.hs0000644000000000000000000000271013077013176016356 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# 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 Data.Monoid.Compat ((<>)) import GHC.Real (Ratio(..), ratioPrec, ratioPrec1) import TextShow.Classes (TextShow(..), showbParen) #if MIN_VERSION_base(4,4,0) import TextShow.Classes (TextShow1(..)) #endif import TextShow.Data.Integral () -- | Note that on @base-4.3.0.0@, this must have a @('TextShow' a, 'Integral' a)@ -- constraint instead of just a @('TextShow' a)@ constraint. -- -- /Since: 2/ instance #if MIN_VERSION_base(4,4,0) TextShow a #else (TextShow a, Integral a) #endif => TextShow (Ratio a) where {-# SPECIALIZE instance TextShow Rational #-} showbPrec p (numer :% denom) = showbParen (p > ratioPrec) $ showbPrec ratioPrec1 numer <> " % " <> showbPrec ratioPrec1 denom {-# INLINE showbPrec #-} #if MIN_VERSION_base(4,4,0) -- | Only available with @base-4.4.0.0@ or later. -- -- /Since: 2/ instance TextShow1 Ratio where liftShowbPrec sp _ p (numer :% denom) = showbParen (p > ratioPrec) $ sp ratioPrec1 numer <> " % " <> sp ratioPrec1 denom {-# INLINE liftShowbPrec #-} #endif text-show-3.6/src/TextShow/Data/Semigroup.hs0000644000000000000000000000231213077013176017250 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 (Min, Max, First, Last, WrappedMonoid, Option, 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 ''Option) -- | /Since: 3/ $(deriveTextShow1 ''Option) -- | /Since: 3/ $(deriveTextShow ''Arg) -- | /Since: 3/ $(deriveTextShow1 ''Arg) -- | /Since: 3/ $(deriveTextShow2 ''Arg) text-show-3.6/src/TextShow/Data/Either.hs0000644000000000000000000000105713077013176016523 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.6/src/TextShow/Data/Dynamic.hs0000644000000000000000000000121013077013176016656 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 Data.Monoid.Compat ((<>)) import Prelude () import TextShow.Classes (TextShow(..)) import TextShow.Data.Typeable () -- | /Since: 2/ instance TextShow Dynamic where showb dyn = "<<" <> showb (dynTypeRep dyn) <> ">>" {-# INLINE showb #-} text-show-3.6/src/TextShow/Data/Maybe.hs0000644000000000000000000000075513077013176016344 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.6/src/TextShow/Data/Text.hs0000644000000000000000000000515313077013176016230 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 'TextShow' instances for 'Text' types. /Since: 2/ -} module TextShow.Data.Text () where import Data.Monoid.Compat ((<>)) import qualified Data.Text as TS import Data.Text.Encoding.Error (UnicodeException(..)) import Data.Text.Foreign (I16) import qualified Data.Text.Lazy as TL import Data.Text.Lazy.Builder (Builder, fromString, toLazyText) 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/ $(deriveTextShow ''I16) -- | /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.6/src/TextShow/Data/Fixed.hs0000644000000000000000000000530013077013176016335 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 (HasResolution(..)) import Data.Text.Lazy.Builder (Builder) import Prelude () import Prelude.Compat import TextShow.Classes (TextShow(..)) #if MIN_VERSION_base(4,7,0) import Data.Fixed (Fixed(..)) import Data.Int (Int64) import Data.Monoid.Compat ((<>)) import Data.Semigroup (mtimesDefault) import Data.Text.Lazy.Builder (singleton) import TextShow.Data.Integral () import TextShow.Utils (lengthB) #else import Data.Fixed (Fixed, showFixed) import Data.Text.Lazy.Builder (fromString) #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 #if MIN_VERSION_base(4,7,0) 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 #else showbFixed chopTrailingZeroes = fromString . showFixed chopTrailingZeroes {-# INLINE showbFixed #-} #endif #if MIN_VERSION_base(4,7,0) -- | 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 #-} #endif -- | /Since: 2/ instance HasResolution a => TextShow (Fixed a) where showb = showbFixed False {-# INLINE showb #-} text-show-3.6/src/TextShow/Data/OldTypeable.hs0000644000000000000000000000375613077013176017517 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,7,0) && !(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,7,0) && !(MIN_VERSION_base(4,8,0)) import Data.Monoid.Compat ((<>)) import Data.OldTypeable.Internal (TyCon(TyCon, tyConName), TypeRep(..), funTc, listTc) import Data.Text.Lazy.Builder (fromString, singleton) 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.6/src/TextShow/Data/ByteString.hs0000644000000000000000000001055213077013176017375 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.6/src/TextShow/Data/Typeable.hs0000644000000000000000000002040213077013176017043 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE OverloadedStrings #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif #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 #if MIN_VERSION_base(4,10,0) import Data.Monoid.Compat ((<>)) import Data.Kind (Type) import Data.Text.Lazy.Builder (Builder, fromString, singleton) import Data.Type.Equality ((:~~:)(..)) import GHC.Exts (Char(..)) import GHC.Prim (Addr#, (+#), eqChar#, indexCharOffAddr#) import GHC.Types (Module(..), TrName(..), TyCon(..), isTrue#) import TextShow.Classes (TextShow(..), TextShow1(..), showbParen, showbSpace) import TextShow.Data.Typeable.Utils (showbArgs, showbTuple) import TextShow.Utils (isTupleString) 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.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (fromString, singleton) import Data.Typeable (TypeRep, typeRepArgs, typeRepTyCon) # if MIN_VERSION_base(4,4,0) 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) # elif MIN_VERSION_base(4,4,0) import Data.Typeable.Internal (funTc, listTc) # endif # else import Data.Typeable (mkTyCon, tyConString, typeOf) # endif # if MIN_VERSION_base(4,9,0) import GHC.Exts (Char(..)) import GHC.Prim (Addr#, (+#), eqChar#, indexCharOffAddr#) import GHC.Types (TyCon(..), TrName(..), Module(..), isTrue#) # elif MIN_VERSION_base(4,4,0) import Data.Typeable.Internal (TyCon) # else import Data.Typeable (TyCon) # endif import TextShow.Classes (TextShow(..), showbParen, showbSpace) import TextShow.Data.List () import TextShow.Data.Typeable.Utils (showbArgs, showbTuple) import TextShow.Utils (isTupleString) #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) # elif MIN_VERSION_base(4,4,0) -- | The list 'TyCon'. tcList :: TyCon tcList = listTc -- | The function (@->@) 'TyCon'. tcFun :: TyCon tcFun = funTc # else -- | The list 'TyCon'. tcList :: TyCon tcList = typeRepTyCon $ typeOf [()] -- | The function (@->@) 'TyCon'. tcFun :: TyCon tcFun = mkTyCon "->" # endif #endif -- | Does the 'TyCon' represent a tuple type constructor? isTupleTyCon :: TyCon -> Bool isTupleTyCon = isTupleString . tyConString {-# INLINE isTupleTyCon #-} #if MIN_VERSION_base(4,4,0) -- | Identical to 'tyConName'. Defined to avoid using excessive amounts of pragmas -- with base-4.3 and earlier, which use 'tyConString'. tyConString :: TyCon -> String tyConString = tyConName {-# INLINE tyConString #-} #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, [ty] <- tys = singleton '[' <> showb ty <> singleton ']' | isTupleTyCon tc = showbTuple tys 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 xs (Con tc) = (tc, xs) go xs (App f x) = go (SomeTypeRep x : xs) f go [] (Fun a b) = (funTyCon, [SomeTypeRep a, SomeTypeRep b]) go _ (Fun _ _) = errorWithoutStackTrace "Data.Typeable.Internal.splitApps: Impossible" 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 . tyConString #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.6/src/TextShow/Data/Char.hs0000644000000000000000000000663113077013176016163 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.Monoid.Compat ((<>)) 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) -- | 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 #-} -- | /Since: 2/ instance TextShow Char where showb = showbChar {-# INLINE showb #-} showbList = showbString {-# INLINE showbList #-} -- | /Since: 2/ $(deriveTextShow ''GeneralCategory) text-show-3.6/src/TextShow/Data/Proxy.hs0000644000000000000000000000173713077013176016431 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif {-# 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 (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.6/src/TextShow/Data/Integral.hs0000644000000000000000000001243213077013176017047 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.Monoid.Compat ((<>)) 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#)) #if __GLASGOW_HASKELL__ >= 708 import GHC.Exts (isTrue#) import GHC.Prim (Int#) #endif import GHC.Prim ((<#), (>#)) 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' where #if __GLASGOW_HASKELL__ >= 708 isTrue :: Int# -> Bool isTrue b = isTrue# b #else isTrue :: Bool -> Bool isTrue = id #endif -- | /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.6/src/TextShow/Data/Version.hs0000644000000000000000000000237213077013176016731 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.Monoid.Compat ((<>)) 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.6/src/TextShow/Data/Complex.hs0000644000000000000000000000245213077013176016712 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# 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' instances for 'Ratio'. Due to use of the @DatatypeContexts@ extension, there is no @TextShow1 Complex@ instance on @base-4.3.0.0@. /Since: 2/ -} module TextShow.Data.Complex () where import Data.Complex (Complex) import TextShow.Classes (TextShow(..)) import TextShow.Data.Floating () import TextShow.TH.Internal (makeShowbPrec) #if MIN_VERSION_base(4,4,0) import TextShow.TH.Internal (deriveTextShow1) #endif -- | Note that on @base-4.3.0.0@, this must have a @('TextShow' a, -- 'RealFloat' a)@ constraint instead of just a @('TextShow' a)@ constraint. -- -- /Since: 2/ instance #if MIN_VERSION_base(4,4,0) TextShow a #else (RealFloat a, TextShow a) #endif => TextShow (Complex a) where {-# SPECIALIZE instance TextShow (Complex Float) #-} {-# SPECIALIZE instance TextShow (Complex Double) #-} showbPrec = $(makeShowbPrec ''Complex) {-# INLINE showbPrec #-} #if MIN_VERSION_base(4,4,0) -- | Only available with @base-4.4.0.0@ or later. -- -- /Since: 2/ $(deriveTextShow1 ''Complex) #endif text-show-3.6/src/TextShow/Data/Data.hs0000644000000000000000000000163313077013176016154 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/ $(deriveTextShow ''DataType) -- | /Since: 2/ $(deriveTextShow ''DataRep) -- | /Since: 2/ $(deriveTextShow ''ConstrRep) -- | /Since: 2/ $(deriveTextShow ''Fixity) -- | /Since: 2/ instance TextShow Constr where showb = fromString . showConstr {-# INLINE showb #-} text-show-3.6/src/TextShow/Data/List.hs0000644000000000000000000000164613077013176016222 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.6/src/TextShow/Data/Void.hs0000644000000000000000000000071613077013176016205 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 (Void, absurd) import Prelude () import TextShow.Classes (TextShow(..)) -- | /Since: 2/ instance TextShow Void where showb = absurd text-show-3.6/src/TextShow/Data/Array.hs0000644000000000000000000000366713077013176016372 0ustar0000000000000000{-# 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.Monoid.Compat ((<>)) 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 > 9) $ "array " <> showb (IArray.bounds a) <> showbSpace <> showb (IArray.assocs a) -- | /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.6/src/TextShow/Data/Monoid.hs0000644000000000000000000000310113077013176016520 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 -- | /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 text-show-3.6/src/TextShow/Data/Type/0000755000000000000000000000000013077013176015665 5ustar0000000000000000text-show-3.6/src/TextShow/Data/Type/Equality.hs0000644000000000000000000000237713077013176020027 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,7,0) {-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #endif {-| 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. Only provided if using @base-4.7.0.0@ or later. /Since: 2/ -} module TextShow.Data.Type.Equality () where #if MIN_VERSION_base(4,7,0) import Data.Type.Equality ((:~:)) # if MIN_VERSION_base(4,10,0) import Data.Type.Equality ((:~~:)) # endif 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,10,0) -- | /Since: 3.6/ $(deriveTextShow ''(:~~:)) -- | /Since: 3.6/ instance TextShow1 ((:~~:) a) where liftShowbPrec = $(makeLiftShowbPrec ''(:~~:)) -- | /Since: 3.6/ $(deriveTextShow2 ''(:~~:)) # endif #endif text-show-3.6/src/TextShow/Data/Type/Coercion.hs0000644000000000000000000000167313077013176017771 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,7,0) {-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #endif {-| 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. Only provided if using @base-4.7.0.0@ or later. /Since: 2/ -} module TextShow.Data.Type.Coercion () where #if MIN_VERSION_base(4,7,0) 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) #endif text-show-3.6/src/TextShow/Data/Typeable/0000755000000000000000000000000013077013176016511 5ustar0000000000000000text-show-3.6/src/TextShow/Data/Typeable/Utils.hs0000644000000000000000000000200213077013176020137 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.Monoid.Compat ((<>)) 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.6/src/TextShow/Data/List/0000755000000000000000000000000013077013176015657 5ustar0000000000000000text-show-3.6/src/TextShow/Data/List/NonEmpty.hs0000644000000000000000000000112013077013176017756 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 (NonEmpty) import TextShow.Data.List () import TextShow.TH.Internal (deriveTextShow, deriveTextShow1) -- | /Since: 3/ $(deriveTextShow ''NonEmpty) -- | /Since: 3/ $(deriveTextShow1 ''NonEmpty) text-show-3.6/src/TextShow/Data/Functor/0000755000000000000000000000000013077013176016364 5ustar0000000000000000text-show-3.6/src/TextShow/Data/Functor/Product.hs0000644000000000000000000000136613077013176020346 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/ instance (TextShow1 f, TextShow1 g, TextShow a) => TextShow (Product f g a) where showbPrec = showbPrec1 {-# INLINE showbPrec #-} -- | /Since: 3/ $(deriveTextShow1 ''Product) text-show-3.6/src/TextShow/Data/Functor/Identity.hs0000644000000000000000000000164013077013176020512 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.6/src/TextShow/Data/Functor/Compose.hs0000644000000000000000000000164413077013176020332 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.6/src/TextShow/Data/Functor/Sum.hs0000644000000000000000000000132613077013176017466 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/ instance (TextShow1 f, TextShow1 g, TextShow a) => TextShow (Sum f g a) where showbPrec = showbPrec1 {-# INLINE showbPrec #-} -- | /Since: 3/ $(deriveTextShow1 ''Sum) text-show-3.6/src/TextShow/Numeric/0000755000000000000000000000000013077013176015475 5ustar0000000000000000text-show-3.6/src/TextShow/Numeric/Natural.hs0000644000000000000000000000164713077013176017447 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,8,0) import GHC.Integer.GMP.Internals (Integer(..)) import GHC.Natural (Natural(..)) import GHC.Types (Word(..)) #else import Numeric.Natural (Natural) #endif import TextShow.Classes (TextShow(..)) import TextShow.Data.Integral () -- | /Since: 2/ instance TextShow Natural where #if MIN_VERSION_base(4,8,0) 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.6/src/TextShow/Foreign/0000755000000000000000000000000013077013176015464 5ustar0000000000000000text-show-3.6/src/TextShow/Foreign/Ptr.hs0000644000000000000000000000430613077013176016570 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.Monoid.Compat ((<>)) import Data.Semigroup (mtimesDefault) import Data.Text.Lazy.Builder (Builder, singleton) import Foreign.ForeignPtr (ForeignPtr) import Foreign.Ptr (FunPtr, IntPtr, WordPtr, castFunPtrToPtr) import GHC.ForeignPtr (unsafeForeignPtrToPtr) import GHC.Num (wordToInteger) import GHC.Ptr (Ptr(..)) import GHC.Prim (addr2Int#, int2Word#) 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 $ wordToInteger (int2Word# (addr2Int# a)) where padOut :: Builder -> Builder padOut ls = singleton '0' <> singleton 'x' <> mtimesDefault (max 0 $ 2*SIZEOF_HSPTR - lengthB ls) (singleton '0') <> ls -- | /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.6/src/TextShow/Foreign/C/0000755000000000000000000000000013077013176015646 5ustar0000000000000000text-show-3.6/src/TextShow/Foreign/C/Types.hs0000644000000000000000000001271513077013176017314 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,5,0) {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} #endif {-# 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 () #if !(MIN_VERSION_base(4,5,0)) import Data.Int import Data.Text.Lazy.Builder (Builder) import Data.Word import Unsafe.Coerce (unsafeCoerce) # include "HsBaseConfig.h" #endif #if MIN_VERSION_base(4,5,0) -- | /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 -- | Only available with @base-4.4.0.0@ or later. -- -- /Since: 2/ deriving instance TextShow CUSeconds -- | Only available with @base-4.4.0.0@ or later. -- -- /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.4.0.0@ or later. -- -- /Since: 3.6/ deriving instance TextShow CBool # endif #else -- | /Since: 2/ instance TextShow CChar where showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_CHAR -> Builder) -- | /Since: 2/ instance TextShow CSChar where showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_SIGNED_CHAR -> Builder) -- | /Since: 2/ instance TextShow CUChar where showb = unsafeCoerce (showb :: HTYPE_UNSIGNED_CHAR -> Builder) -- | /Since: 2/ instance TextShow CShort where showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_SHORT -> Builder) -- | /Since: 2/ instance TextShow CUShort where showb = unsafeCoerce (showb :: HTYPE_UNSIGNED_SHORT -> Builder) -- | /Since: 2/ instance TextShow CInt where showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_INT -> Builder) -- | /Since: 2/ instance TextShow CUInt where showb = unsafeCoerce (showb :: HTYPE_UNSIGNED_INT -> Builder) -- | /Since: 2/ instance TextShow CLong where showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_LONG -> Builder) -- | /Since: 2/ instance TextShow CULong where showb = unsafeCoerce (showb :: HTYPE_UNSIGNED_LONG -> Builder) -- | /Since: 2/ instance TextShow CPtrdiff where showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_PTRDIFF_T -> Builder) -- | /Since: 2/ instance TextShow CSize where showb = unsafeCoerce (showb :: HTYPE_SIZE_T -> Builder) -- | /Since: 2/ instance TextShow CWchar where showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_WCHAR_T -> Builder) -- | /Since: 2/ instance TextShow CSigAtomic where showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_SIG_ATOMIC_T -> Builder) -- | /Since: 2/ instance TextShow CLLong where showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_LONG_LONG -> Builder) -- | /Since: 2/ instance TextShow CULLong where showb = unsafeCoerce (showb :: HTYPE_UNSIGNED_LONG_LONG -> Builder) -- | /Since: 2/ instance TextShow CIntPtr where showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_INTPTR_T -> Builder) -- | /Since: 2/ instance TextShow CUIntPtr where showb = unsafeCoerce (showb :: HTYPE_UINTPTR_T -> Builder) -- | /Since: 2/ instance TextShow CIntMax where showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_INTMAX_T -> Builder) -- | /Since: 2/ instance TextShow CUIntMax where showb = unsafeCoerce (showb :: HTYPE_UINTMAX_T -> Builder) -- | /Since: 2/ instance TextShow CClock where showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_CLOCK_T -> Builder) -- | /Since: 2/ instance TextShow CTime where showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_TIME_T -> Builder) # if MIN_VERSION_base(4,4,0) -- | Only available with @base-4.4.0.0@ or later. -- -- /Since: 2/ instance TextShow CUSeconds where showb = unsafeCoerce (showb :: HTYPE_USECONDS_T -> Builder) -- | Only available with @base-4.4.0.0@ or later. -- -- /Since: 2/ instance TextShow CSUSeconds where showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_SUSECONDS_T -> Builder) # endif -- | /Since: 2/ instance TextShow CFloat where showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_FLOAT -> Builder) -- | /Since: 2/ instance TextShow CDouble where showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_DOUBLE -> Builder) #endif text-show-3.6/src/TextShow/System/0000755000000000000000000000000013077013176015357 5ustar0000000000000000text-show-3.6/src/TextShow/System/Exit.hs0000644000000000000000000000077013077013176016630 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.6/src/TextShow/System/IO.hs0000644000000000000000000000417113077013176016225 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# 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.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (Builder, fromString, singleton) import GHC.IO.Encoding.Types (TextEncoding(textEncodingName)) #if MIN_VERSION_base(4,4,0) import GHC.IO.Encoding.Failure (CodingFailureMode) import GHC.IO.Encoding.Types (CodingProgress) #endif import GHC.IO.Handle (HandlePosn(..)) import GHC.IO.Handle.Types (Handle(..)) 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 #-} #if MIN_VERSION_base(4,4,0) -- | Only available with @base-4.4.0.0@ or later. -- -- /Since: 2/ $(deriveTextShow ''CodingProgress) -- | Only available with @base-4.4.0.0@ or later. -- -- /Since: 2/ $(deriveTextShow ''CodingFailureMode) #endif -- | /Since: 2/ $(deriveTextShow ''Newline) -- | /Since: 2/ $(deriveTextShow ''NewlineMode) text-show-3.6/src/TextShow/System/Posix/0000755000000000000000000000000013077013176016461 5ustar0000000000000000text-show-3.6/src/TextShow/System/Posix/Types.hs0000644000000000000000000001223413077013176020123 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/ -} #include "HsBaseConfig.h" 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 () #if !(MIN_VERSION_base(4,5,0)) import Data.Int import Data.Text.Lazy.Builder (Builder) import Data.Word import Unsafe.Coerce (unsafeCoerce) # include "HsBaseConfig.h" #endif #if MIN_VERSION_base(4,5,0) # 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 #else # if defined(HTYPE_DEV_T) -- | /Since: 2/ instance TextShow CDev where showb = unsafeCoerce (showb :: HTYPE_DEV_T -> Builder) # endif # if defined(HTYPE_INO_T) -- | /Since: 2/ instance TextShow CIno where showb = unsafeCoerce (showb :: HTYPE_INO_T -> Builder) # endif # if defined(HTYPE_MODE_T) -- | /Since: 2/ instance TextShow CMode where showb = unsafeCoerce (showb :: HTYPE_MODE_T -> Builder) # endif # if defined(HTYPE_OFF_T) -- | /Since: 2/ instance TextShow COff where showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_OFF_T -> Builder) # endif # if defined(HTYPE_PID_T) -- | /Since: 2/ instance TextShow CPid where showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_PID_T -> Builder) # endif # if defined(HTYPE_SSIZE_T) -- | /Since: 2/ instance TextShow CSsize where showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_SSIZE_T -> Builder) # endif # if defined(HTYPE_GID_T) -- | /Since: 2/ instance TextShow CGid where showb = unsafeCoerce (showb :: HTYPE_GID_T -> Builder) # endif # if defined(HTYPE_NLINK_T) -- | /Since: 2/ instance TextShow CNlink where showb = unsafeCoerce (showb :: HTYPE_NLINK_T -> Builder) # endif # if defined(HTYPE_UID_T) -- | /Since: 2/ instance TextShow CUid where showb = unsafeCoerce (showb :: HTYPE_UID_T -> Builder) # endif # if defined(HTYPE_CC_T) -- | /Since: 2/ instance TextShow CCc where showb = unsafeCoerce (showb :: HTYPE_CC_T -> Builder) # endif # if defined(HTYPE_SPEED_T) -- | /Since: 2/ instance TextShow CSpeed where showb = unsafeCoerce (showb :: HTYPE_SPEED_T -> Builder) # endif # if defined(HTYPE_TCFLAG_T) -- | /Since: 2/ instance TextShow CTcflag where showb = unsafeCoerce (showb :: HTYPE_TCFLAG_T -> Builder) # endif # if defined(HTYPE_RLIM_T) -- | /Since: 2/ instance TextShow CRLim where showb = unsafeCoerce (showb :: HTYPE_RLIM_T -> Builder) # endif #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.6/src/TextShow/Debug/0000755000000000000000000000000013077013176015121 5ustar0000000000000000text-show-3.6/src/TextShow/Debug/Trace.hs0000644000000000000000000002662613077013176016527 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 #if MIN_VERSION_base(4,5,0) , tracetStack , tracetlStack #endif , tracetIO , tracetlIO , tracetM , tracetlM , traceTextShowM #if MIN_VERSION_base(4,5,0) -- * Eventlog tracing -- $eventlog_tracing , tracetEvent , tracetlEvent , tracetEventIO , tracetlEventIO #endif #if MIN_VERSION_base(4,7,0) -- * Execution phase markers -- $markers , tracetMarker , tracetlMarker , tracetMarkerIO , tracetlMarkerIO #endif ) where import Control.Monad (unless) import qualified Data.ByteString as BS (null, partition) import Data.ByteString (ByteString, useAsCString) import Data.ByteString.Internal (c2w) import qualified Data.Text as TS (Text) import Data.Text.Encoding (encodeUtf8) import qualified Data.Text.Lazy as TL (Text) import Data.Text.Lazy (toStrict) import Foreign.C.String (CString) #if MIN_VERSION_base(4,5,0) import qualified Data.ByteString.Char8 as BS (pack) import qualified Data.Text as TS (unpack) import qualified Data.Text.Lazy as TL (unpack) import Debug.Trace import GHC.Stack (currentCallStack, renderStack) #endif 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 #if MIN_VERSION_base(4,5,0) -- | 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 #endif #if MIN_VERSION_base(4,7,0) -- $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 #endif text-show-3.6/src/TextShow/Debug/Trace/0000755000000000000000000000000013077013176016157 5ustar0000000000000000text-show-3.6/src/TextShow/Debug/Trace/TH.hs0000644000000000000000000000263313077013176017032 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.6/src/TextShow/Debug/Trace/Generic.hs0000644000000000000000000000234213077013176020070 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, Zero, genericShowt) -- | A 'Generic' implementation of 'traceTextShow'. -- -- /Since: 2/ genericTraceTextShow :: (Generic a, GTextShowT Zero (Rep a)) => a -> b -> b genericTraceTextShow = tracet . genericShowt -- | A 'Generic' implementation of 'traceTextShowId'. -- -- /Since: 2/ genericTraceTextShowId :: (Generic a, GTextShowT Zero (Rep a)) => a -> a genericTraceTextShowId a = tracet (genericShowt a) a -- | A 'Generic' implementation of 'traceShowM'. -- -- /Since: 2/ genericTraceTextShowM :: (Generic a, GTextShowT Zero (Rep a), Applicative f) => a -> f () genericTraceTextShowM = tracetM . genericShowt text-show-3.6/tests/0000755000000000000000000000000013077013176012661 5ustar0000000000000000text-show-3.6/tests/Spec.hs0000644000000000000000000000005413077013176014106 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} text-show-3.6/tests/Instances/0000755000000000000000000000000013077013176014610 5ustar0000000000000000text-show-3.6/tests/Instances/Utils.hs0000644000000000000000000000060613077013176016246 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 utility functions. -} module Instances.Utils ((<@>)) where 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.6/tests/Instances/Options.hs0000644000000000000000000000117213077013176016600 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# 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 Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) import TextShow.TH (Options(..), GenTextMethods) deriving instance Arbitrary Options instance Arbitrary GenTextMethods where arbitrary = arbitraryBoundedEnum text-show-3.6/tests/Instances/FromStringTextShow.hs0000644000000000000000000000211213077013176020740 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.6/tests/Instances/Generic.hs0000644000000000000000000000102613077013176016517 0ustar0000000000000000{-# 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 'Arbitrary' instance for 'ConType'. -} module Instances.Generic () where import Instances.Data.Text () import Instances.Utils.GenericArbitrary (genericArbitrary) import Test.QuickCheck (Arbitrary(..)) import TextShow.Generic (ConType(..)) instance Arbitrary ConType where arbitrary = genericArbitrary text-show-3.6/tests/Instances/GHC/0000755000000000000000000000000013077013176015211 5ustar0000000000000000text-show-3.6/tests/Instances/GHC/StaticPtr.hs0000644000000000000000000000141413077013176017462 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.6/tests/Instances/GHC/Fingerprint.hs0000644000000000000000000000210213077013176020027 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,4,0) {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #endif {-| 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 #if MIN_VERSION_base(4,4,0) import GHC.Fingerprint.Type (Fingerprint(..)) # if __GLASGOW_HASKELL__ >= 704 import GHC.Generics (Generic) # else import qualified Generics.Deriving.TH as Generics (deriveAll0) # endif import Instances.Utils.GenericArbitrary (genericArbitrary) import Test.QuickCheck (Arbitrary(..)) instance Arbitrary Fingerprint where arbitrary = genericArbitrary # if __GLASGOW_HASKELL__ >= 704 deriving instance Generic Fingerprint # else $(Generics.deriveAll0 ''Fingerprint) # endif #endif text-show-3.6/tests/Instances/GHC/Generics.hs0000644000000000000000000000432513077013176017310 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.6/tests/Instances/GHC/Stack.hs0000644000000000000000000000267613077013176016625 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) import qualified Generics.Deriving.TH as Generics (deriveAll0) # 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 import Instances.Utils.GenericArbitrary (genericArbitrary) import Test.QuickCheck (Arbitrary(..)) 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 # if !(MIN_VERSION_base(4,9,0)) $(Generics.deriveAll0 ''CallStack) # endif $(Generics.deriveAll0 ''SrcLoc) #endif text-show-3.6/tests/Instances/GHC/Event.hs0000644000000000000000000000201213077013176016621 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) && MIN_VERSION_base(4,4,0) 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.6/tests/Instances/GHC/TypeLits.hs0000644000000000000000000000242013077013176017320 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,6,0) && !(MIN_VERSION_base(4,7,0)) {-# LANGUAGE PolyKinds #-} #endif {-# 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 #if MIN_VERSION_base(4,6,0) import GHC.TypeLits import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) # if MIN_VERSION_base(4,7,0) import Test.QuickCheck (getNonNegative) # endif #endif #if MIN_VERSION_base(4,7,0) instance Arbitrary SomeNat where arbitrary = do nat <- getNonNegative <$> arbitrary case someNatVal nat of Just sn -> pure sn Nothing -> fail "Negative natural number" -- Should never happen instance Arbitrary SomeSymbol where arbitrary = someSymbolVal <$> arbitrary #elif MIN_VERSION_base(4,6,0) instance SingI a => Arbitrary (Sing a) where arbitrary = pure sing instance SingI n => Arbitrary (IsZero n) where arbitrary = pure $ isZero sing instance SingI n => Arbitrary (IsEven n) where arbitrary = pure $ isEven sing #endif text-show-3.6/tests/Instances/GHC/Stats.hs0000644000000000000000000000143013077013176016641 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,5,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,5,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.6/tests/Instances/GHC/RTS/0000755000000000000000000000000013077013176015661 5ustar0000000000000000text-show-3.6/tests/Instances/GHC/RTS/Flags.hs0000644000000000000000000000554613077013176017263 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 #-} #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 instance Arbitrary RTSFlags where arbitrary = genericArbitrary instance Arbitrary GCFlags where arbitrary = genericArbitrary instance Arbitrary ConcFlags where arbitrary = genericArbitrary 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) -- TODO: Perhaps we should add deriving (Enum, Bounded) to deriving-compat -- and use that instead of Generic? instance Arbitrary GiveGCStats' where arbitrary = genericArbitrary instance Arbitrary DoCostCentres' where arbitrary = genericArbitrary instance Arbitrary DoHeapProfile' where arbitrary = genericArbitrary instance Arbitrary DoTrace' where arbitrary = genericArbitrary $(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 text-show-3.6/tests/Instances/GHC/Conc/0000755000000000000000000000000013077013176016073 5ustar0000000000000000text-show-3.6/tests/Instances/GHC/Conc/Windows.hs0000644000000000000000000000124013077013176020056 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.6/tests/Instances/Text/0000755000000000000000000000000013077013176015534 5ustar0000000000000000text-show-3.6/tests/Instances/Text/Read.hs0000644000000000000000000000262613077013176016751 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} #endif {-# 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(..)) #if MIN_VERSION_base(4,6,0) import Language.Haskell.TH.Lib (conT) import TextShow.TH.Names (numberTypeName) #endif instance Arbitrary Lexeme where arbitrary = genericArbitrary #if MIN_VERSION_base(4,6,0) -- NB: Don't attempt to define -- -- type Number' = $(conT numberTypeName) -- -- here. Sadly, due to a bizarre GHC 7.6 bug, it'll think it's a recursive -- type synonym and reject it. instance Arbitrary $(conT numberTypeName) where arbitrary = genericArbitrary #endif $(Generics.deriveAll0 ''Lexeme) #if MIN_VERSION_base(4,6,0) $(Generics.deriveAll0 numberTypeName) #endif text-show-3.6/tests/Instances/Control/0000755000000000000000000000000013077013176016230 5ustar0000000000000000text-show-3.6/tests/Instances/Control/Concurrent.hs0000644000000000000000000000236613077013176020715 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #endif {-# 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 #if __GLASGOW_HASKELL__ >= 704 import GHC.Generics (Generic) #else import qualified Generics.Deriving.TH as Generics (deriveAll0) #endif import GHC.Conc (BlockReason(..), ThreadStatus(..)) 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 #if __GLASGOW_HASKELL__ >= 704 deriving instance Generic ThreadStatus #else $(Generics.deriveAll0 ''ThreadStatus) #endif text-show-3.6/tests/Instances/Control/Exception.hs0000644000000000000000000001125113077013176020522 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #endif {-# 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) #if __GLASGOW_HASKELL__ >= 704 import GHC.Generics (Generic) #else import qualified Generics.Deriving.TH as Generics (deriveAll0) #endif import GHC.IO.Exception (IOException(..), IOErrorType(..)) 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 #if MIN_VERSION_base(4,7,0) instance Arbitrary SomeAsyncException where arbitrary = SomeAsyncException <$> (arbitrary :: Gen AsyncException) #endif 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 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 #if __GLASGOW_HASKELL__ >= 704 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 #else $(Generics.deriveAll0 ''ArrayException) $(Generics.deriveAll0 ''AssertionFailed) $(Generics.deriveAll0 ''IOException) $(Generics.deriveAll0 ''Deadlock) $(Generics.deriveAll0 ''NoMethodError) $(Generics.deriveAll0 ''PatternMatchFail) $(Generics.deriveAll0 ''RecConError) $(Generics.deriveAll0 ''RecSelError) $(Generics.deriveAll0 ''RecUpdError) $(Generics.deriveAll0 ''ErrorCall) #endif text-show-3.6/tests/Instances/Control/Monad/0000755000000000000000000000000013077013176017266 5ustar0000000000000000text-show-3.6/tests/Instances/Control/Monad/ST.hs0000644000000000000000000000076713077013176020162 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.6/tests/Instances/Data/0000755000000000000000000000000013077013176015461 5ustar0000000000000000text-show-3.6/tests/Instances/Data/Floating.hs0000644000000000000000000000113713077013176017562 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) deriving instance Bounded FPFormat instance Arbitrary FPFormat where arbitrary = arbitraryBoundedEnum text-show-3.6/tests/Instances/Data/Tuple.hs0000644000000000000000000000653013077013176017112 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #endif {-# 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 Data.Orphans () #if __GLASGOW_HASKELL__ >= 704 import GHC.Generics (Generic) #else import qualified Generics.Deriving.TH as Generics (deriveAll0) #endif 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 #if __GLASGOW_HASKELL__ >= 704 deriving instance Generic (a, b, c, d, e, f, g, h, i, j, k) deriving instance Generic (a, b, c, d, e, f, g, h, i, j, k, l) deriving instance Generic (a, b, c, d, e, f, g, h, i, j, k, l, m) deriving instance Generic (a, b, c, d, e, f, g, h, i, j, k, l, m, n) deriving instance Generic (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) #else $(Generics.deriveAll0 ''(,,,,,,,,,,)) $(Generics.deriveAll0 ''(,,,,,,,,,,,)) $(Generics.deriveAll0 ''(,,,,,,,,,,,,)) $(Generics.deriveAll0 ''(,,,,,,,,,,,,,)) $(Generics.deriveAll0 ''(,,,,,,,,,,,,,,)) #endif text-show-3.6/tests/Instances/Data/Ord.hs0000644000000000000000000000076513077013176016551 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.6/tests/Instances/Data/Semigroup.hs0000644000000000000000000000261113077013176017767 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# 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' instances for datatypes in the "Data.Semigroup" module. -} module Instances.Data.Semigroup () where import Data.Semigroup (Min(..), Max(..), First(..), Last(..), WrappedMonoid(..), Option(..), Arg(..)) #if __GLASGOW_HASKELL__ < 702 import qualified Generics.Deriving.TH as Generics (deriveAll0) #endif import Instances.Utils.GenericArbitrary (genericArbitrary) import Test.QuickCheck (Arbitrary(..)) deriving instance Arbitrary a => Arbitrary (Min a) deriving instance Arbitrary a => Arbitrary (Max a) deriving instance Arbitrary a => Arbitrary (First a) deriving instance Arbitrary a => Arbitrary (Last a) deriving instance Arbitrary a => Arbitrary (WrappedMonoid a) deriving instance Arbitrary a => Arbitrary (Option a) instance (Arbitrary a, Arbitrary b) => Arbitrary (Arg a b) where arbitrary = genericArbitrary #if __GLASGOW_HASKELL__ < 702 $(Generics.deriveAll0 ''Arg) #endif text-show-3.6/tests/Instances/Data/Dynamic.hs0000644000000000000000000000100313077013176017373 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.6/tests/Instances/Data/Text.hs0000644000000000000000000000377413077013176016754 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #endif {-# 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.Foreign (I16) 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 #if __GLASGOW_HASKELL__ >= 704 import GHC.Generics (Generic) #else import qualified Generics.Deriving.TH as Generics (deriveAll0) #endif import Instances.Utils.GenericArbitrary (genericArbitrary) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) import Test.QuickCheck.Instances () instance Arbitrary Builder where arbitrary = fromString <$> arbitrary instance Arbitrary I16 where arbitrary = arbitraryBoundedEnum 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 #if __GLASGOW_HASKELL__ >= 704 deriving instance Generic UnicodeException #else $(Generics.deriveAll0 ''UnicodeException) #endif text-show-3.6/tests/Instances/Data/OldTypeable.hs0000644000000000000000000000227513077013176020227 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,7,0) && !(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,7,0) && !(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.6/tests/Instances/Data/ByteString.hs0000644000000000000000000000102613077013176020106 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.ByteString Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'ShortByteString'. -} module Instances.Data.ByteString () where import Data.ByteString.Short (ShortByteString, pack) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) instance Arbitrary ShortByteString where arbitrary = pack <$> arbitrary text-show-3.6/tests/Instances/Data/Typeable.hs0000644000000000000000000001022413077013176017561 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif {-# 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,4,0) import Instances.Utils ((<@>)) #endif #if MIN_VERSION_base(4,9,0) import GHC.Types (TyCon(..), TrName(..), Module(..)) # if WORD_SIZE_IN_BITS < 64 import GHC.Word (Word64(..)) # else import GHC.Word (Word(..)) # endif import Test.QuickCheck (oneof) #elif MIN_VERSION_base(4,4,0) import Data.Typeable.Internal (TyCon(..)) #endif #if MIN_VERSION_base(4,10,0) import GHC.Exts (Int(..), Ptr(..)) import GHC.Types (KindRep(..), RuntimeRep(..), TypeLitSort(..), VecCount(..), VecElem(..)) import Type.Reflection (SomeTypeRep(..), Typeable, TypeRep, typeRep) #elif MIN_VERSION_base(4,4,0) import Data.Typeable.Internal (TypeRep(..)) #else import Data.Typeable (TyCon, TypeRep, mkTyCon, typeOf) #endif import Instances.Foreign.Ptr () import Instances.GHC.Fingerprint () 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 [] , pure LiftedRep , pure UnliftedRep , 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 # if MIN_VERSION_base(4,4,0) arbitrary = TypeRep <$> arbitrary <*> arbitrary # if MIN_VERSION_base(4,8,0) <@> [] <@> [] # else <@> [] # endif # else arbitrary = typeOf <$> (arbitrary :: Gen Int) # endif #endif instance Arbitrary TyCon where #if MIN_VERSION_base(4,9,0) arbitrary = do # if WORD_SIZE_IN_BITS < 64 W64# w1# <- arbitrary W64# w2# <- arbitrary # else W# w1# <- arbitrary W# w2# <- arbitrary # endif # 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 #elif MIN_VERSION_base(4,4,0) arbitrary = TyCon <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary #else arbitrary = mkTyCon <$> arbitrary #endif #if MIN_VERSION_base(4,9,0) instance Arbitrary TrName where arbitrary = oneof [pure (TrNameS "wat"#), TrNameD <$> arbitrary] instance Arbitrary Module where arbitrary = Module <$> arbitrary <*> arbitrary #endif text-show-3.6/tests/Instances/Data/Char.hs0000644000000000000000000000074613077013176016701 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.6/tests/Instances/Data/Proxy.hs0000644000000000000000000000151213077013176017135 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} #endif {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Proxy Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances for 'Proxy'. -} module Instances.Data.Proxy () where import Data.Proxy (Proxy(..)) #if __GLASGOW_HASKELL__ < 702 import qualified Generics.Deriving.TH as Generics (deriveAll0) #endif import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) instance Arbitrary (Proxy s) where arbitrary = arbitraryBoundedEnum #if __GLASGOW_HASKELL__ < 702 $(Generics.deriveAll0 ''Proxy) #endif text-show-3.6/tests/Instances/Data/Data.hs0000644000000000000000000000323613077013176016672 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #endif {-# 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) #if __GLASGOW_HASKELL__ >= 704 import GHC.Generics (Generic) #else import qualified Generics.Deriving.TH as Generics (deriveAll0) #endif 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 #if __GLASGOW_HASKELL__ >= 704 deriving instance Generic ConstrRep deriving instance Generic DataRep #else $(Generics.deriveAll0 ''ConstrRep) $(Generics.deriveAll0 ''DataRep) #endif text-show-3.6/tests/Instances/Data/Type/0000755000000000000000000000000013077013176016402 5ustar0000000000000000text-show-3.6/tests/Instances/Data/Type/Equality.hs0000644000000000000000000000160213077013176020532 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif {-# 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 #if MIN_VERSION_base(4,7,0) import Data.Type.Equality ((:~:)) # if MIN_VERSION_base(4,10,0) import Data.Type.Equality ((:~~:), type (~~)) # endif import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) instance a ~ b => Arbitrary (a :~: b) where arbitrary = arbitraryBoundedEnum # if MIN_VERSION_base(4,10,0) instance a ~~ b => Arbitrary (a :~~: b) where arbitrary = arbitraryBoundedEnum # endif #endif text-show-3.6/tests/Instances/Data/Type/Coercion.hs0000644000000000000000000000124213077013176020476 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif {-# 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 #if MIN_VERSION_base(4,7,0) 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 #endif text-show-3.6/tests/Instances/Data/Functor/0000755000000000000000000000000013077013176017101 5ustar0000000000000000text-show-3.6/tests/Instances/Data/Functor/Product.hs0000644000000000000000000000133313077013176021055 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif {-| Module: Instances.Data.Functor.Product Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'Product'. -} module Instances.Data.Functor.Product () where import Data.Functor.Product (Product(..)) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) instance (Arbitrary (f a), Arbitrary (g a)) => Arbitrary (Product f g a) where arbitrary = Pair <$> arbitrary <*> arbitrary text-show-3.6/tests/Instances/Data/Functor/Compose.hs0000644000000000000000000000131013077013176021035 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif {-| Module: Instances.Data.Functor.Compose Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'Compose'. -} module Instances.Data.Functor.Compose () where import Data.Functor.Compose (Compose(..)) import Test.QuickCheck (Arbitrary) deriving instance Arbitrary (f (g a)) => Arbitrary (Compose f g a) text-show-3.6/tests/Instances/Data/Functor/Sum.hs0000644000000000000000000000132613077013176020203 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif {-| Module: Instances.Data.Functor.Sum Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'Sum'. -} module Instances.Data.Functor.Sum () where import Data.Functor.Sum (Sum(..)) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..), oneof) instance (Arbitrary (f a), Arbitrary (g a)) => Arbitrary (Sum f g a) where arbitrary = oneof [InL <$> arbitrary, InR <$> arbitrary] text-show-3.6/tests/Instances/Foreign/0000755000000000000000000000000013077013176016201 5ustar0000000000000000text-show-3.6/tests/Instances/Foreign/Ptr.hs0000644000000000000000000000154113077013176017303 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.6/tests/Instances/Foreign/C/0000755000000000000000000000000013077013176016363 5ustar0000000000000000text-show-3.6/tests/Instances/Foreign/C/Types.hs0000644000000000000000000000753313077013176020033 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,5,0) {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} #endif {-# 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 import Foreign.C.Types import Test.QuickCheck (Arbitrary(..)) #if !(MIN_VERSION_base(4,5,0)) import Data.Int # if MIN_VERSION_base(4,4,0) import Data.Word # endif import Test.QuickCheck (Gen, arbitrarySizedBoundedIntegral, arbitrarySizedFractional) import Unsafe.Coerce (unsafeCoerce) # include "HsBaseConfig.h" #endif #if MIN_VERSION_base(4,5,0) deriving instance Arbitrary CChar deriving instance Arbitrary CSChar deriving instance Arbitrary CUChar deriving instance Arbitrary CShort deriving instance Arbitrary CUShort deriving instance Arbitrary CInt deriving instance Arbitrary CUInt deriving instance Arbitrary CLong deriving instance Arbitrary CULong deriving instance Arbitrary CLLong deriving instance Arbitrary CULLong deriving instance Arbitrary CFloat deriving instance Arbitrary CDouble deriving instance Arbitrary CPtrdiff deriving instance Arbitrary CSize deriving instance Arbitrary CWchar deriving instance Arbitrary CSigAtomic deriving instance Arbitrary CClock deriving instance Arbitrary CTime deriving instance Arbitrary CUSeconds deriving instance Arbitrary CSUSeconds deriving instance Arbitrary CIntPtr deriving instance Arbitrary CUIntPtr deriving instance Arbitrary CIntMax deriving instance Arbitrary CUIntMax # if MIN_VERSION_base(4,10,0) deriving instance Arbitrary CBool # endif #else instance Arbitrary CChar where arbitrary = arbitrarySizedBoundedIntegral instance Arbitrary CSChar where arbitrary = arbitrarySizedBoundedIntegral instance Arbitrary CUChar where arbitrary = arbitrarySizedBoundedIntegral instance Arbitrary CShort where arbitrary = arbitrarySizedBoundedIntegral instance Arbitrary CUShort where arbitrary = arbitrarySizedBoundedIntegral instance Arbitrary CInt where arbitrary = arbitrarySizedBoundedIntegral instance Arbitrary CUInt where arbitrary = arbitrarySizedBoundedIntegral instance Arbitrary CLong where arbitrary = arbitrarySizedBoundedIntegral instance Arbitrary CULong where arbitrary = arbitrarySizedBoundedIntegral instance Arbitrary CLLong where arbitrary = arbitrarySizedBoundedIntegral instance Arbitrary CULLong where arbitrary = arbitrarySizedBoundedIntegral instance Arbitrary CFloat where arbitrary = arbitrarySizedFractional instance Arbitrary CDouble where arbitrary = arbitrarySizedFractional instance Arbitrary CPtrdiff where arbitrary = arbitrarySizedBoundedIntegral instance Arbitrary CSize where arbitrary = arbitrarySizedBoundedIntegral instance Arbitrary CWchar where arbitrary = arbitrarySizedBoundedIntegral instance Arbitrary CSigAtomic where arbitrary = arbitrarySizedBoundedIntegral instance Arbitrary CClock where arbitrary = unsafeCoerce (arbitrary :: Gen HTYPE_CLOCK_T) instance Arbitrary CTime where arbitrary = unsafeCoerce (arbitrary :: Gen HTYPE_TIME_T) # if MIN_VERSION_base(4,4,0) instance Arbitrary CUSeconds where arbitrary = unsafeCoerce (arbitrary :: Gen HTYPE_USECONDS_T) instance Arbitrary CSUSeconds where arbitrary = unsafeCoerce (arbitrary :: Gen HTYPE_SUSECONDS_T) # endif instance Arbitrary CIntPtr where arbitrary = arbitrarySizedBoundedIntegral instance Arbitrary CUIntPtr where arbitrary = arbitrarySizedBoundedIntegral instance Arbitrary CIntMax where arbitrary = arbitrarySizedBoundedIntegral instance Arbitrary CUIntMax where arbitrary = arbitrarySizedBoundedIntegral #endif text-show-3.6/tests/Instances/Utils/0000755000000000000000000000000013077013176015710 5ustar0000000000000000text-show-3.6/tests/Instances/Utils/GenericArbitrary.hs0000644000000000000000000001133413077013176021502 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.6/tests/Instances/System/0000755000000000000000000000000013077013176016074 5ustar0000000000000000text-show-3.6/tests/Instances/System/Exit.hs0000644000000000000000000000106413077013176017342 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.System.Exit Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'ExitCode'. -} module Instances.System.Exit () where import Data.Orphans () import Generics.Deriving.Base () import Instances.Utils.GenericArbitrary (genericArbitrary) import System.Exit (ExitCode(..)) import Test.QuickCheck (Arbitrary(..)) instance Arbitrary ExitCode where arbitrary = genericArbitrary text-show-3.6/tests/Instances/System/IO.hs0000644000000000000000000000476513077013176016753 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #endif {-# 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 #if __GLASGOW_HASKELL__ >= 704 import GHC.Generics (Generic) #else import qualified Generics.Deriving.TH as Generics (deriveAll0) #endif #if MIN_VERSION_base(4,4,0) import GHC.IO.Encoding.Failure (CodingFailureMode(..)) import GHC.IO.Encoding.Types (CodingProgress(..)) #endif import GHC.IO.Handle (HandlePosn(..)) import Instances.Utils.GenericArbitrary (genericArbitrary) import Prelude () import Prelude.Compat import System.IO (BufferMode(..), IOMode(..), Newline(..), NewlineMode(..), 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 #if MIN_VERSION_base(4,4,0) 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 #endif deriving instance Bounded Newline deriving instance Enum Newline instance Arbitrary Newline where arbitrary = arbitraryBoundedEnum instance Arbitrary NewlineMode where arbitrary = genericArbitrary #if __GLASGOW_HASKELL__ >= 704 deriving instance Generic HandlePosn deriving instance Generic BufferMode deriving instance Generic NewlineMode #else $(Generics.deriveAll0 ''HandlePosn) $(Generics.deriveAll0 ''BufferMode) $(Generics.deriveAll0 ''NewlineMode) #endif text-show-3.6/tests/Instances/System/Posix/0000755000000000000000000000000013077013176017176 5ustar0000000000000000text-show-3.6/tests/Instances/System/Posix/Types.hs0000644000000000000000000000745513077013176020651 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(..)) #if !(MIN_VERSION_base(4,5,0)) import Data.Word import Test.QuickCheck (Gen, arbitrarySizedBoundedIntegral) import Unsafe.Coerce (unsafeCoerce) #endif #include "HsBaseConfig.h" #if MIN_VERSION_base(4,5,0) # 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 #else # if defined(HTYPE_DEV_T) instance Arbitrary CDev where arbitrary = unsafeCoerce (arbitrary :: Gen HTYPE_DEV_T) # endif # if defined(HTYPE_INO_T) instance Arbitrary CIno where arbitrary = arbitrarySizedBoundedIntegral # endif # if defined(HTYPE_MODE_T) instance Arbitrary CMode where arbitrary = arbitrarySizedBoundedIntegral # endif # if defined(HTYPE_OFF_T) instance Arbitrary COff where arbitrary = arbitrarySizedBoundedIntegral # endif # if defined(HTYPE_PID_T) instance Arbitrary CPid where arbitrary = arbitrarySizedBoundedIntegral # endif # if defined(HTYPE_SSIZE_T) instance Arbitrary CSsize where arbitrary = arbitrarySizedBoundedIntegral # endif # if defined(HTYPE_GID_T) instance Arbitrary CGid where arbitrary = arbitrarySizedBoundedIntegral # endif # if defined(HTYPE_NLINK_T) instance Arbitrary CNlink where arbitrary = arbitrarySizedBoundedIntegral # endif # if defined(HTYPE_UID_T) instance Arbitrary CUid where arbitrary = arbitrarySizedBoundedIntegral # endif # if defined(HTYPE_CC_T) instance Arbitrary CCc where arbitrary = unsafeCoerce (arbitrary :: Gen HTYPE_CC_T) # endif # if defined(HTYPE_SPEED_T) instance Arbitrary CSpeed where arbitrary = unsafeCoerce (arbitrary :: Gen HTYPE_SPEED_T) # endif # if defined(HTYPE_TCFLAG_T) instance Arbitrary CTcflag where arbitrary = arbitrarySizedBoundedIntegral # endif # if defined(HTYPE_RLIM_T) instance Arbitrary CRLim where arbitrary = arbitrarySizedBoundedIntegral # endif #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.6/tests/Spec/0000755000000000000000000000000013077013176013553 5ustar0000000000000000text-show-3.6/tests/Spec/Utils.hs0000644000000000000000000001074013077013176015211 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-| 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 ) where import Data.Functor.Classes (Show1, showsPrec1) import Data.Proxy (Proxy(..)) import Generics.Deriving.Base import Test.Hspec (Spec) import Test.Hspec.QuickCheck (prop) import Test.QuickCheck (Arbitrary) 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 -- | 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 -> Bool) -- | Verifies that a type's 'Show' instances coincide for both 'String's and 'Text', -- irrespective of precedence. prop_matchesTextShow :: (Show a, TextShow a) => Int -> a -> Bool prop_matchesTextShow p x = fromString (showsPrec p x "") == showbPrec 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 -> Bool) -- | 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 -> Bool prop_matchesTextShow1 p x = fromString (showsPrec1 p x "") == showbPrec1 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 -> Bool) -- | 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 -> Bool prop_matchesTextShow2 p x = fromString (showsPrec2 p x "") == showbPrec2 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 Zero (Rep a)) => Proxy a -> Spec genericTextShowSpec _ = prop "generic TextShow" (prop_genericTextShow :: Int -> a -> Bool) -- | Verifies that a type's 'TextShow' instance coincides with the output produced -- by the equivalent 'Generic' functions. prop_genericTextShow :: (TextShow a, Generic a, GTextShowB Zero (Rep a)) => Int -> a -> Bool prop_genericTextShow p x = showbPrec p x == 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, GTextShowB One (Rep1 f), TextShow a) => Proxy (f a) -> Spec genericTextShow1Spec _ = prop "generic TextShow1" (prop_genericTextShow1 :: Int -> f a -> Bool) -- | Verifies that a type's 'TextShow1' instance coincides with the output produced -- by the equivalent 'Generic1' functions. prop_genericTextShow1 :: ( TextShow1 f, Generic1 f , GTextShowB One (Rep1 f), TextShow a ) => Int -> f a -> Bool prop_genericTextShow1 p x = showbPrec1 p x == genericLiftShowbPrec showbPrec showbList p x text-show-3.6/tests/Spec/OptionsSpec.hs0000644000000000000000000000153713077013176016363 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 (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.6/tests/Spec/FunctionsSpec.hs0000644000000000000000000000115713077013176016676 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 (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.6/tests/Spec/GenericSpec.hs0000644000000000000000000000121413077013176016274 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 (Proxy(..)) import Instances.Generic () import Spec.Utils (matchesTextShowSpec, genericTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) import TextShow.Generic (ConType) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "ConType" $ do let p :: Proxy ConType p = Proxy matchesTextShowSpec p genericTextShowSpec p text-show-3.6/tests/Spec/FromStringTextShowSpec.hs0000644000000000000000000000445313077013176020530 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 (Proxy(..)) import Instances.FromStringTextShow () import Spec.Utils (matchesTextShowSpec, matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) import TextShow (FromStringShow(..), FromTextShow(..)) #if defined(NEW_FUNCTOR_CLASSES) import Spec.Utils (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 matchesTextShow1Spec p describe "FromStringShow String" $ do let p :: Proxy (FromStringShow String) p = Proxy matchesTextShowSpec p matchesTextShow1Spec p describe "FromTextShow Int" $ do let p :: Proxy (FromTextShow Int) p = Proxy matchesTextShowSpec p matchesTextShow1Spec p describe "FromTextShow String" $ do let p :: Proxy (FromTextShow String) p = Proxy matchesTextShowSpec p matchesTextShow1Spec p #if defined(NEW_FUNCTOR_CLASSES) describe "FromStringShow1 Maybe Int" $ do let p :: Proxy (FromStringShow1 Maybe Int) p = Proxy matchesTextShowSpec p matchesTextShow1Spec p describe "FromTextShow1 Maybe Int" $ do let p :: Proxy (FromTextShow1 Maybe Int) p = Proxy matchesTextShowSpec p matchesTextShow1Spec p describe "FromStringShow2 Either Char Int" $ do let p :: Proxy (FromStringShow2 Either Char Int) p = Proxy matchesTextShowSpec p matchesTextShow1Spec p matchesTextShow2Spec p describe "FromTextShow2 Either Char Int" $ do let p :: Proxy (FromTextShow2 Either Char Int) p = Proxy matchesTextShowSpec p matchesTextShow1Spec p matchesTextShow2Spec p #endif text-show-3.6/tests/Spec/BuilderSpec.hs0000644000000000000000000000336113077013176016313 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 (Spec, describe, hspec, parallel) 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 -> Bool prop_lengthB s = fromIntegral (lengthB $ fromString s) == length s -- | Verifies @fromText . toText = id@. prop_toText :: Builder -> Bool prop_toText b = fromText (toText b) == b -- | Verifies @fromString . toString = id@. prop_toString :: Builder -> Bool prop_toString b = fromString (toString b) == b -- | Verifies 'unlinesB' and 'unlines' produce the same output. prop_unlinesB :: [String] -> Bool prop_unlinesB strs = unlinesB (map fromString strs) == fromString (unlines strs) -- | Verifies 'unwordsB' and 'unwords' produce the same output. prop_unwordsB :: [String] -> Bool prop_unwordsB strs = unwordsB (map fromString strs) == 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.6/tests/Spec/GHC/0000755000000000000000000000000013077013176014154 5ustar0000000000000000text-show-3.6/tests/Spec/GHC/FingerprintSpec.hs0000644000000000000000000000147413077013176017620 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| 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.Orphans () import Instances.GHC.Fingerprint () import Prelude () import Prelude.Compat import Test.Hspec (Spec, hspec, parallel) #if MIN_VERSION_base(4,4,0) import Data.Proxy (Proxy(..)) import GHC.Fingerprint.Type (Fingerprint) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe) #endif main :: IO () main = hspec spec spec :: Spec spec = parallel $ #if MIN_VERSION_base(4,4,0) describe "Fingerprint" $ matchesTextShowSpec (Proxy :: Proxy Fingerprint) #else pure () #endif text-show-3.6/tests/Spec/GHC/StatsSpec.hs0000644000000000000000000000144113077013176016421 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,5,0) import Data.Proxy (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,5,0) describe "GCStats" $ matchesTextShowSpec (Proxy :: Proxy GCStats) #else pure () #endif text-show-3.6/tests/Spec/GHC/TypeLitsSpec.hs0000644000000000000000000000305313077013176017101 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,6,0) && !(MIN_VERSION_base(4,7,0)) {-# LANGUAGE DataKinds #-} #endif {-| 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 Instances.GHC.TypeLits () import Prelude () import Prelude.Compat import Test.Hspec (Spec, hspec, parallel) #if MIN_VERSION_base(4,6,0) import Data.Proxy (Proxy(..)) import GHC.TypeLits import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe) #endif main :: IO () main = hspec spec spec :: Spec spec = parallel $ do #if MIN_VERSION_base(4,7,0) describe "SomeNat" $ matchesTextShowSpec (Proxy :: Proxy SomeNat) describe "SomeSymbol" $ matchesTextShowSpec (Proxy :: Proxy SomeSymbol) #elif MIN_VERSION_base(4,6,0) describe "IsEven 0" $ matchesTextShowSpec (Proxy :: Proxy (IsEven 0)) describe "IsEven 1" $ matchesTextShowSpec (Proxy :: Proxy (IsEven 1)) describe "IsEven 2" $ matchesTextShowSpec (Proxy :: Proxy (IsEven 2)) describe "IsZero 0" $ matchesTextShowSpec (Proxy :: Proxy (IsZero 0)) describe "IsZero 1" $ matchesTextShowSpec (Proxy :: Proxy (IsZero 1)) describe "Sing 0" $ matchesTextShowSpec (Proxy :: Proxy (Sing 0)) describe "Sing \"a\"" $ matchesTextShowSpec (Proxy :: Proxy (Sing "a")) #else pure () #endif text-show-3.6/tests/Spec/GHC/EventSpec.hs0000644000000000000000000000220013077013176016376 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) && MIN_VERSION_base(4,4,0) import Data.Proxy (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) && MIN_VERSION_base(4,4,0) 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.6/tests/Spec/GHC/StackSpec.hs0000644000000000000000000000167613077013176016402 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 (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.6/tests/Spec/GHC/GenericsSpec.hs0000644000000000000000000001045213077013176017064 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TypeOperators #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} #endif {-| 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 (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.6/tests/Spec/GHC/StaticPtrSpec.hs0000644000000000000000000000143213077013176017240 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 (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.6/tests/Spec/GHC/RTS/0000755000000000000000000000000013077013176014624 5ustar0000000000000000text-show-3.6/tests/Spec/GHC/RTS/FlagsSpec.hs0000644000000000000000000000353213077013176017032 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 (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) 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.6/tests/Spec/GHC/Conc/0000755000000000000000000000000013077013176015036 5ustar0000000000000000text-show-3.6/tests/Spec/GHC/Conc/WindowsSpec.hs0000644000000000000000000000152613077013176017643 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 (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.6/tests/Spec/Text/0000755000000000000000000000000013077013176014477 5ustar0000000000000000text-show-3.6/tests/Spec/Text/ReadSpec.hs0000644000000000000000000000163413077013176016525 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-| 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 (Proxy(..)) import Instances.Text.Read () import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) import Text.Read (Lexeme) #if MIN_VERSION_base(4,6,0) import Language.Haskell.TH.Lib (conT) import TextShow.TH.Names (numberTypeName) #endif main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "Lexeme" $ matchesTextShowSpec (Proxy :: Proxy Lexeme) #if MIN_VERSION_base(4,6,0) describe "Number" $ matchesTextShowSpec (Proxy :: Proxy $(conT numberTypeName)) #endif text-show-3.6/tests/Spec/Control/0000755000000000000000000000000013077013176015173 5ustar0000000000000000text-show-3.6/tests/Spec/Control/ApplicativeSpec.hs0000644000000000000000000000177613077013176020616 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 (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.6/tests/Spec/Control/ConcurrentSpec.hs0000644000000000000000000000231613077013176020466 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 (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.6/tests/Spec/Control/ExceptionSpec.hs0000644000000000000000000000537613077013176020313 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 import Data.Proxy (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) #if MIN_VERSION_base(4,7,0) describe "SomeAsyncException" $ matchesTextShowSpec (Proxy :: Proxy SomeAsyncException) #endif 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 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.6/tests/Spec/Control/Monad/0000755000000000000000000000000013077013176016231 5ustar0000000000000000text-show-3.6/tests/Spec/Control/Monad/STSpec.hs0000644000000000000000000000057313077013176017733 0ustar0000000000000000module Spec.Control.Monad.STSpec (main, spec) where import Control.Monad.ST import Data.Proxy (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.6/tests/Spec/Data/0000755000000000000000000000000013077013176014424 5ustar0000000000000000text-show-3.6/tests/Spec/Data/EitherSpec.hs0000644000000000000000000000127713077013176017022 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 (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.6/tests/Spec/Data/SemigroupSpec.hs0000644000000000000000000000230013077013176017540 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 (Proxy(..)) import Data.Semigroup (Min, Max, First, Last, WrappedMonoid, Option, Arg) import Instances.Data.Semigroup () import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) 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 "Option Int" $ matchesTextShowSpec (Proxy :: Proxy (Option Int)) describe "Arg Int Char" $ matchesTextShowSpec (Proxy :: Proxy (Arg Int Char)) text-show-3.6/tests/Spec/Data/MaybeSpec.hs0000644000000000000000000000124513077013176016632 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 (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.6/tests/Spec/Data/CharSpec.hs0000644000000000000000000000170113077013176016447 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 (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.6/tests/Spec/Data/BoolSpec.hs0000644000000000000000000000113713077013176016470 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 (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.6/tests/Spec/Data/TypeableSpec.hs0000644000000000000000000000410113077013176017334 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} #endif {-| 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 (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 [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 (Either Int)" $ matchesTextShowSpec (Proxy :: Proxy (TypeRep (Either Int))) #else describe "TypeRep" $ matchesTextShowSpec (Proxy :: Proxy TypeRep) #endif text-show-3.6/tests/Spec/Data/DynamicSpec.hs0000644000000000000000000000112113077013176017152 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 (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.6/tests/Spec/Data/ArraySpec.hs0000644000000000000000000000201113077013176016643 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 (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.6/tests/Spec/Data/TupleSpec.hs0000644000000000000000000000654713077013176016700 0ustar0000000000000000{-| 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 (Proxy(..)) import Generics.Deriving.Instances () import Instances.Data.Tuple () 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 "()" $ 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)) text-show-3.6/tests/Spec/Data/FloatingSpec.hs0000644000000000000000000000424713077013176017345 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 (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 (Gen, arbitrary, 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 -> Gen Bool prop_showXFloat f1 f2 val = do digs <- arbitrary `suchThat` (<= 10) pure $ fromString (f1 (Just digs) val "") == f2 (Just digs) val text-show-3.6/tests/Spec/Data/OldTypeableSpec.hs0000644000000000000000000000207013077013176017776 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,7,0) && !(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.Monoid" 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,7,0) && !(MIN_VERSION_base(4,8,0)) import Data.OldTypeable (TyCon, TypeRep) import Data.Proxy (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,7,0) && !(MIN_VERSION_base(4,8,0)) describe "TypeRep" $ matchesTextShowSpec (Proxy :: Proxy TypeRep) describe "TyCon" $ matchesTextShowSpec (Proxy :: Proxy TyCon) #else pure () #endif text-show-3.6/tests/Spec/Data/DataSpec.hs0000644000000000000000000000171313077013176016446 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 (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.6/tests/Spec/Data/RatioSpec.hs0000644000000000000000000000105613077013176016653 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 (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.6/tests/Spec/Data/TextSpec.hs0000644000000000000000000000307013077013176016517 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 (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) import Data.Text.Foreign (I16) #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 "I16" $ matchesTextShowSpec (Proxy :: Proxy I16) 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.6/tests/Spec/Data/ByteStringSpec.hs0000644000000000000000000000206013077013176017663 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 (Proxy(..)) import Instances.Data.ByteString () 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.6/tests/Spec/Data/IntegralSpec.hs0000644000000000000000000000455213077013176017346 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 (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 Control.Applicative (liftA2) import Data.Char (intToDigit) import Numeric (showIntAtBase) import Test.QuickCheck (Gen, arbitrary, getNonNegative, suchThat) 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 Bool prop_showIntAtBase = do base <- arbitrary `suchThat` liftA2 (&&) (> 1) (<= 16) i <- getNonNegative <$> arbitrary :: Gen Int pure $ fromString (showIntAtBase base intToDigit i "") == showbIntAtBase base intToDigit i #endif text-show-3.6/tests/Spec/Data/MonoidSpec.hs0000644000000000000000000000372213077013176017024 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 (Proxy(..)) import Generics.Deriving.Instances () 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 text-show-3.6/tests/Spec/Data/OrdSpec.hs0000644000000000000000000000151313077013176016317 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 (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.6/tests/Spec/Data/ProxySpec.hs0000644000000000000000000000123013077013176016710 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 (Proxy(..)) import Generics.Deriving.Base () import Instances.Data.Proxy () import Spec.Utils (matchesTextShowSpec, genericTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) 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.6/tests/Spec/Data/ListSpec.hs0000644000000000000000000000215413077013176016510 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 (Proxy(..)) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) 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 -> Bool prop_showListWith str = fromString (showListWith shows str "") == showbListWith showb str text-show-3.6/tests/Spec/Data/FixedSpec.hs0000644000000000000000000000271213077013176016634 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 (Proxy(..)) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) 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 -> Bool prop_showFixed b f = fromString (showFixed b f) == showbFixed b f text-show-3.6/tests/Spec/Data/VersionSpec.hs0000644000000000000000000000135113077013176017220 0ustar0000000000000000module Spec.Data.VersionSpec (main, spec) where import Data.Proxy (Proxy(..)) import Data.Version (Version, showVersion) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) 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 -> Bool prop_showVersion v = fromString (showVersion v) == showbVersion v text-show-3.6/tests/Spec/Data/ComplexSpec.hs0000644000000000000000000000107713077013176017207 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 (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.6/tests/Spec/Data/Type/0000755000000000000000000000000013077013176015345 5ustar0000000000000000text-show-3.6/tests/Spec/Data/Type/CoercionSpec.hs0000644000000000000000000000152113077013176020254 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 Instances.Data.Type.Coercion () import Prelude () import Prelude.Compat import Test.Hspec (Spec, hspec, parallel) #if MIN_VERSION_base(4,7,0) import Data.Monoid (All(..)) import Data.Proxy (Proxy(..)) import Data.Type.Coercion (Coercion) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe) #endif main :: IO () main = hspec spec spec :: Spec spec = parallel $ #if MIN_VERSION_base(4,7,0) describe "Coercion All Bool" $ matchesTextShowSpec (Proxy :: Proxy (Coercion All Bool)) #else pure () #endif text-show-3.6/tests/Spec/Data/Type/EqualitySpec.hs0000644000000000000000000000202613077013176020311 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 Instances.Data.Type.Equality () import Prelude () import Prelude.Compat import Test.Hspec (Spec, hspec, parallel) #if MIN_VERSION_base(4,7,0) import Data.Proxy (Proxy(..)) import Data.Type.Equality ((:~:)) # if MIN_VERSION_base(4,10,0) import Data.Type.Equality ((:~~:)) # 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,7,0) describe "Int :~: Int" $ matchesTextShowSpec (Proxy :: Proxy (Int :~: Int)) # if MIN_VERSION_base(4,10,0) describe "Int :~~: Int" $ matchesTextShowSpec (Proxy :: Proxy (Int :~~: Int)) # endif #else pure () #endif text-show-3.6/tests/Spec/Data/List/0000755000000000000000000000000013077013176015337 5ustar0000000000000000text-show-3.6/tests/Spec/Data/List/NonEmptySpec.hs0000644000000000000000000000114613077013176020261 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 (Proxy(..)) import Data.List.NonEmpty (NonEmpty) import Data.Orphans () import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "NonEmpty Int" $ matchesTextShow1Spec (Proxy :: Proxy (NonEmpty Int)) text-show-3.6/tests/Spec/Data/Functor/0000755000000000000000000000000013077013176016044 5ustar0000000000000000text-show-3.6/tests/Spec/Data/Functor/ProductSpec.hs0000644000000000000000000000127613077013176020641 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 (Proxy(..)) import Instances.Data.Functor.Product () import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Product Maybe Maybe Int" $ matchesTextShow1Spec (Proxy :: Proxy (Product Maybe Maybe Int)) text-show-3.6/tests/Spec/Data/Functor/ComposeSpec.hs0000644000000000000000000000127613077013176020626 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 (Proxy(..)) import Instances.Data.Functor.Compose () import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Compose Maybe Maybe Int" $ matchesTextShow1Spec (Proxy :: Proxy (Compose Maybe Maybe Int)) text-show-3.6/tests/Spec/Data/Functor/IdentitySpec.hs0000644000000000000000000000120313077013176021000 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 (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.6/tests/Spec/Data/Functor/SumSpec.hs0000644000000000000000000000123613077013176017761 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 (Proxy(..)) import Instances.Data.Functor.Sum () import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Sum Maybe Maybe Int" $ matchesTextShow1Spec (Proxy :: Proxy (Sum Maybe Maybe Int)) text-show-3.6/tests/Spec/Numeric/0000755000000000000000000000000013077013176015155 5ustar0000000000000000text-show-3.6/tests/Spec/Numeric/NaturalSpec.hs0000644000000000000000000000106713077013176017736 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 (Proxy(..)) import Numeric.Natural (Natural) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Natural" $ matchesTextShowSpec (Proxy :: Proxy Natural) text-show-3.6/tests/Spec/Foreign/0000755000000000000000000000000013077013176015144 5ustar0000000000000000text-show-3.6/tests/Spec/Foreign/PtrSpec.hs0000644000000000000000000000253413077013176017064 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 (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.6/tests/Spec/Foreign/C/0000755000000000000000000000000013077013176015326 5ustar0000000000000000text-show-3.6/tests/Spec/Foreign/C/TypesSpec.hs0000644000000000000000000000514013077013176017601 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 (Proxy(..)) import Foreign.C.Types import Instances.Foreign.C.Types () import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) 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) #if MIN_VERSION_base(4,4,0) describe "CUSeconds" $ matchesTextShowSpec (Proxy :: Proxy CUSeconds) describe "CSUSeconds" $ matchesTextShowSpec (Proxy :: Proxy CSUSeconds) #endif 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.6/tests/Spec/System/0000755000000000000000000000000013077013176015037 5ustar0000000000000000text-show-3.6/tests/Spec/System/IOSpec.hs0000644000000000000000000000456313077013176016525 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| 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 (Proxy(..)) #if MIN_VERSION_base(4,4,0) import GHC.IO.Encoding.Failure (CodingFailureMode) import GHC.IO.Encoding.Types (CodingProgress) #endif 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 #if MIN_VERSION_base(4,4,0) describe "CodingProgress" $ matchesTextShowSpec (Proxy :: Proxy CodingProgress) describe "CodingFailureMode" $ matchesTextShowSpec (Proxy :: Proxy CodingFailureMode) #endif 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.6/tests/Spec/System/ExitSpec.hs0000644000000000000000000000111613077013176017116 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 (Proxy(..)) import Instances.System.Exit () import Spec.Utils (matchesTextShowSpec) import System.Exit (ExitCode) import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "ExitCode" $ matchesTextShowSpec (Proxy :: Proxy ExitCode) text-show-3.6/tests/Spec/System/Posix/0000755000000000000000000000000013077013176016141 5ustar0000000000000000text-show-3.6/tests/Spec/System/Posix/TypesSpec.hs0000644000000000000000000000572013077013176020420 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 (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.6/tests/Spec/Derived/0000755000000000000000000000000013077013176015135 5ustar0000000000000000text-show-3.6/tests/Spec/Derived/DatatypeContextsSpec.hs0000644000000000000000000000147013077013176021611 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| 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 (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)) #if MIN_VERSION_template_haskell(2,7,0) describe "TyFamily Int Int Int" $ matchesTextShow1Spec (Proxy :: Proxy (TyFamily Int Int Int)) #endif text-show-3.6/tests/Spec/Derived/DataFamiliesSpec.hs0000644000000000000000000000363713077013176020640 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} #endif {-| 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 Prelude () import Prelude.Compat import Test.Hspec (Spec, hspec, parallel) #if MIN_VERSION_template_haskell(2,7,0) import Data.Proxy (Proxy(..)) import Derived.DataFamilies (NotAllShow) import Spec.Utils (matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (describe) # if __GLASGOW_HASKELL__ >= 706 import Derived.DataFamilies (KindDistinguished) # endif # if __GLASGOW_HASKELL__ >= 708 import Derived.DataFamilies (NullaryData) import Spec.Utils (matchesTextShowSpec) # endif #endif main :: IO () main = hspec spec spec :: Spec spec = parallel $ do #if MIN_VERSION_template_haskell(2,7,0) describe "NotAllShow Int Int Int Int" $ do let p :: Proxy (NotAllShow Int Int Int Int) p = Proxy matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p # if __GLASGOW_HASKELL__ >= 706 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 # endif # if __GLASGOW_HASKELL__ >= 708 describe "NullaryData" $ do let p :: Proxy NullaryData p = Proxy matchesTextShowSpec p genericTextShowSpec p # endif #else pure () #endif text-show-3.6/tests/Spec/Derived/MagicHashSpec.hs0000644000000000000000000000205213077013176020127 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-| 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 (Proxy(..)) import Derived.MagicHash 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 #if MIN_VERSION_template_haskell(2,7,0) describe "TyFamily# Int Int" $ do let p :: Proxy (TyFamily# Int Int) p = Proxy matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p #endif text-show-3.6/tests/Spec/Derived/RecordsSpec.hs0000644000000000000000000000175513077013176017715 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| 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 (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 #if MIN_VERSION_template_haskell(2,7,0) describe "TyFamily Int Int" $ do let p :: Proxy (TyFamily Int Int) p = Proxy matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p #endif text-show-3.6/tests/Spec/Derived/PolyKindsSpec.hs0000644000000000000000000000407013077013176020221 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| 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 (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 #if MIN_VERSION_template_haskell(2,7,0) 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 #endif text-show-3.6/tests/Spec/Derived/InfixSpec.hs0000644000000000000000000000261513077013176017365 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| 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 (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 #if MIN_VERSION_template_haskell(2,7,0) 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 #endif text-show-3.6/tests/Spec/Derived/ExistentialQuantificationSpec.hs0000644000000000000000000000154013077013176023474 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| 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 (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)) #if MIN_VERSION_template_haskell(2,7,0) describe "TyFamily Int Int Int Int" $ matchesTextShow1Spec (Proxy :: Proxy (TyFamily Int Int Int Int)) #endif text-show-3.6/tests/Spec/Derived/TypeSynonymsSpec.hs0000644000000000000000000000177713077013176021021 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| 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 (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 #if MIN_VERSION_template_haskell(2,7,0) describe "TyFamily Int Int" $ do let p :: Proxy (TyFamily Int Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p genericTextShow1Spec p #endif text-show-3.6/tests/Spec/Derived/RankNTypesSpec.hs0000644000000000000000000000141513077013176020343 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| 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 (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)) #if MIN_VERSION_template_haskell(2,7,0) describe "TyFamily Int Int" $ matchesTextShow1Spec (Proxy :: Proxy (TyFamily Int Int)) #endif text-show-3.6/tests/Derived/0000755000000000000000000000000013077013176014243 5ustar0000000000000000text-show-3.6/tests/Derived/ExistentialQuantification.hs0000644000000000000000000001133213077013176021767 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-| 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 MIN_VERSION_template_haskell(2,7,0) # if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 'TyFamilyClassConstraints) # else $(deriveShow1 'TyFamilyTypeRefinement1) $(deriveShow2 'TyFamilyTypeRefinement1) # endif $(deriveTextShow 'TyFamilyClassConstraints) $(deriveTextShow1 'TyFamilyTypeRefinement1) $(deriveTextShow2 'TyFamilyTypeRefinement2) #endif text-show-3.6/tests/Derived/TypeSynonyms.hs0000644000000000000000000000661613077013176017311 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} #endif {-# 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 #include "generic.h" #if !defined(__LANGUAGE_DERIVE_GENERIC1__) import qualified Generics.Deriving.TH as Generics #endif #if __GLASGOW_HASKELL__ >= 702 import GHC.Generics (Generic) # if __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic1) # endif #endif 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 -- Needed for the Generic1 instances instance Functor ((,,,) a b c) where fmap f (a, b, c, d) = (a, b, c, f d) ------------------------------------------------------------------------------- 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 #if __GLASGOW_HASKELL__ >= 702 , Generic # if __GLASGOW_HASKELL__ >= 706 , Generic1 # endif #endif ) ------------------------------------------------------------------------------- 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 #if __GLASGOW_HASKELL__ >= 706 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #endif ) ------------------------------------------------------------------------------- -- TODO: Replace these with non-orphan instances $(deriveShow1 ''(,,,)) #if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2 ''(,,,)) #endif $(deriveShow1 ''TyCon) #if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2 ''TyCon) #endif $(deriveTextShow ''TyCon) $(deriveTextShow1 ''TyCon) $(deriveTextShow2 ''TyCon) #if __GLASGOW_HASKELL__ < 706 $(Generics.deriveMeta ''TyCon) $(Generics.deriveRepresentable1 ''TyCon) #endif #if __GLASGOW_HASKELL__ < 702 $(Generics.deriveRepresentable0 ''TyCon) #endif #if MIN_VERSION_template_haskell(2,7,0) # if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 'TyFamily) # else $(deriveShow1 'TyFamily) $(deriveShow2 'TyFamily) # endif $(deriveTextShow 'TyFamily) $(deriveTextShow1 'TyFamily) $(deriveTextShow2 'TyFamily) # if !defined(__LANGUAGE_DERIVE_GENERIC1__) $(Generics.deriveMeta 'TyFamily) $(Generics.deriveRepresentable1 'TyFamily) # endif # if __GLASGOW_HASKELL__ < 706 $(Generics.deriveRepresentable0 'TyFamily) # endif #endif text-show-3.6/tests/Derived/MagicHash.hs0000644000000000000000000000612113077013176016423 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} #endif {-| 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#(..)) 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 ) ------------------------------------------------------------------------------- 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 ) ------------------------------------------------------------------------------- instance (Arbitrary a, Arbitrary b) => Arbitrary (TyCon# a b) where arbitrary = genericArbitrary #if MIN_VERSION_template_haskell(2,7,0) instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamily# a b) where arbitrary = genericArbitrary #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 MIN_VERSION_template_haskell(2,7,0) # 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 #endif text-show-3.6/tests/Derived/RankNTypes.hs0000644000000000000000000000667013077013176016646 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 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 MIN_VERSION_template_haskell(2,7,0) # if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 'TyFamily) # else $(deriveShow1 'TyFamily) $(deriveShow2 'TyFamily) # endif $(deriveTextShow 'TyFamily) $(deriveTextShow1 'TyFamily) $(deriveTextShow2 'TyFamily) #endif ------------------------------------------------------------------------------- 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) text-show-3.6/tests/Derived/PolyKinds.hs0000644000000000000000000002744713077013176016531 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} #endif {-# 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 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))) #if __GLASGOW_HASKELL__ >= 702 deriving Generic #endif 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 #if __GLASGOW_HASKELL__ >= 702 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #endif ) ------------------------------------------------------------------------------- newtype TyConReallyHighKinds f a b c d e = TyConReallyHighKinds (f a b c d e) deriving ( Arbitrary , Show #if __GLASGOW_HASKELL__ >= 702 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #endif ) ------------------------------------------------------------------------------- data family TyFamilyCompose #if __GLASGOW_HASKELL__ >= 706 (t :: k1 -> k2 -> *) (u :: k3 -> k4 -> k1) (v :: k3 -> k4 -> k2) (w :: k5 -> k3) (x :: k5 -> k4) (y :: k5) (z :: k5) #else (t :: * -> * -> *) (u :: * -> * -> *) (v :: * -> * -> *) (w :: * -> *) (x :: * -> *) (y :: *) (z :: *) #endif :: * newtype instance TyFamilyCompose f g h j k a b = TyFamilyCompose (f (g (j a) (k a)) (h (j a) (k b))) #if __GLASGOW_HASKELL__ >= 706 deriving Generic #endif deriving instance Arbitrary (f (g (j a) (k a)) (h (j a) (k b))) => Arbitrary (TyFamilyCompose f g h j k a b) #if defined(__LANGUAGE_DERIVE_GENERIC1__) deriving instance ( Functor (f (g (j a) (k a))) , Functor (h (j a)) ) => Generic1 (TyFamilyCompose f g h j k a) #endif deriving instance Show (f (g (j a) (k a)) (h (j a) (k b))) => Show (TyFamilyCompose f g h j k a b) ------------------------------------------------------------------------------- data family TyFamilyProxy #if __GLASGOW_HASKELL__ >= 706 (x :: k1) (y :: k2) #else (x :: *) (y :: *) #endif :: * newtype instance TyFamilyProxy a b where TyFamilyProxy :: () -> TyFamilyProxy a b deriving ( Arbitrary , Show #if __GLASGOW_HASKELL__ >= 706 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #endif ) ------------------------------------------------------------------------------- data family TyFamilyReallyHighKinds #if __GLASGOW_HASKELL__ >= 706 (g :: k1 -> k2 -> k3 -> k4 -> k5 -> *) (v :: k1) (w :: k2) (x :: k3) (y :: k4) (z :: k5) #else (g :: * -> * -> * -> * -> * -> *) (v :: *) (w :: *) (x :: *) (y :: *) (z :: *) #endif :: * newtype instance TyFamilyReallyHighKinds f a b c d e = TyFamilyReallyHighKinds (f a b c d e) deriving ( Arbitrary , Show #if __GLASGOW_HASKELL__ >= 706 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #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 __GLASGOW_HASKELL__ < 702 $(Generics.deriveRepresentable0 ''TyConCompose) $(Generics.deriveRepresentable0 ''TyConProxy) $(Generics.deriveRepresentable0 ''TyConReallyHighKinds) #endif #if MIN_VERSION_template_haskell(2,7,0) # 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 # if __GLASGOW_HASKELL__ < 706 $(Generics.deriveRepresentable0 'TyFamilyCompose) $(Generics.deriveRepresentable0 'TyFamilyProxy) $(Generics.deriveRepresentable0 'TyFamilyReallyHighKinds) # endif #endif text-show-3.6/tests/Derived/Records.hs0000644000000000000000000000632313077013176016204 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} #endif {-| 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 #if __GLASGOW_HASKELL__ >= 702 import GHC.Generics (Generic) # if __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic1) # endif #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) ------------------------------------------------------------------------------- infixl 4 :@: data TyCon a b = TyConPrefix { tc1 :: a, tc2 :: b } | (:@:) { tc3 :: b, (##) :: a } deriving ( Show #if __GLASGOW_HASKELL__ >= 702 , Generic # if __GLASGOW_HASKELL__ >= 706 , Generic1 # endif #endif ) ------------------------------------------------------------------------------- data family TyFamily y z :: * infixl 4 :!: data instance TyFamily a b = TyFamilyPrefix { tf1 :: a, tf2 :: b } | (:!:) { tf3 :: b, (###) :: a } deriving ( Show #if __GLASGOW_HASKELL__ >= 706 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #endif ) ------------------------------------------------------------------------------- instance (Arbitrary a, Arbitrary b) => Arbitrary (TyCon a b) where arbitrary = genericArbitrary #if MIN_VERSION_template_haskell(2,7,0) instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamily a b) where arbitrary = genericArbitrary #endif ------------------------------------------------------------------------------- $(deriveShow1 ''TyCon) #if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2 ''TyCon) #endif $(deriveTextShow ''TyCon) $(deriveTextShow1 ''TyCon) $(deriveTextShow2 ''TyCon) #if __GLASGOW_HASKELL__ < 706 $(Generics.deriveMeta ''TyCon) $(Generics.deriveRepresentable1 ''TyCon) #endif #if __GLASGOW_HASKELL__ < 702 $(Generics.deriveRepresentable0 ''TyCon) #endif #if MIN_VERSION_template_haskell(2,7,0) # 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 # if __GLASGOW_HASKELL__ < 706 $(Generics.deriveRepresentable0 'TyFamilyPrefix) # endif #endif text-show-3.6/tests/Derived/Infix.hs0000644000000000000000000001250113077013176015653 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} #endif {-| 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 #if __GLASGOW_HASKELL__ >= 702 import GHC.Generics (Generic) # if __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic1) # endif #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) ------------------------------------------------------------------------------- infixl 3 :!: infix 4 :@: infixr 5 `TyConPlain` infixr 6 `TyConFakeInfix` data TyConPlain a b = (:!:) a b | a :@: b | a `TyConPlain` b | TyConFakeInfix a b deriving ( Show #if __GLASGOW_HASKELL__ >= 702 , Generic # if __GLASGOW_HASKELL__ >= 706 , Generic1 # endif #endif ) ------------------------------------------------------------------------------- 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 #if __GLASGOW_HASKELL__ >= 706 , Generic , Generic1 #endif ) ------------------------------------------------------------------------------- data family TyFamilyPlain y z :: * infixl 3 :#: infix 4 :$: infixr 5 `TyFamilyPlain` infixr 6 `TyFamilyFakeInfix` data instance TyFamilyPlain a b = (:#:) a b | a :$: b | a `TyFamilyPlain` b | TyFamilyFakeInfix a b deriving ( Show #if __GLASGOW_HASKELL__ >= 706 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #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 #if __GLASGOW_HASKELL__ >= 706 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #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 #if MIN_VERSION_template_haskell(2,7,0) instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamilyPlain a b) where arbitrary = genericArbitrary instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamilyGADT a b) where arbitrary = genericArbitrary #endif ------------------------------------------------------------------------------- $(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 __GLASGOW_HASKELL__ < 706 $(Generics.deriveMeta ''TyConPlain) $(Generics.deriveRepresentable1 ''TyConPlain) $(Generics.deriveAll0And1 ''TyConGADT) #endif #if __GLASGOW_HASKELL__ < 702 $(Generics.deriveRepresentable0 ''TyConPlain) #endif #if MIN_VERSION_template_haskell(2,7,0) # 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 # if __GLASGOW_HASKELL__ < 706 $(Generics.deriveRepresentable0 'TyFamilyPlain) $(Generics.deriveRepresentable0 '(:***)) # endif #endif text-show-3.6/tests/Derived/DatatypeContexts.hs0000644000000000000000000000641413077013176020107 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 MIN_VERSION_template_haskell(2,7,0) # 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) #endif text-show-3.6/tests/Derived/DataFamilies.hs0000644000000000000000000001137413077013176017130 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} #endif #if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710 -- Starting with GHC 7.10, NullaryTypeClasses was deprecated in favor of -- MultiParamTypeClasses, which is already enabled {-# 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(..) #if __GLASGOW_HASKELL__ >= 706 , KindDistinguished(..) #endif #if __GLASGOW_HASKELL__ >= 708 , NullaryClass(..) , NullaryData(..) #endif ) where #include "generic.h" #if !defined(__LANGUAGE_DERIVE_GENERIC1__) import qualified Generics.Deriving.TH as Generics #endif #if __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic) # if defined(__LANGUAGE_DERIVE_GENERIC1__) import GHC.Generics (Generic1) # endif #endif import Instances.Utils.GenericArbitrary (genericArbitrary) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) #if MIN_VERSION_template_haskell(2,7,0) import Text.Show.Deriving (deriveShow1) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) # if defined(NEW_FUNCTOR_CLASSES) import Text.Show.Deriving (deriveShow2) # endif #endif ------------------------------------------------------------------------------- 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 #if __GLASGOW_HASKELL__ >= 706 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #endif ) instance (Arbitrary b, Arbitrary c, Arbitrary d) => Arbitrary (NotAllShow Int b c d) where arbitrary = genericArbitrary #if MIN_VERSION_template_haskell(2,7,0) # 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 # if __GLASGOW_HASKELL__ < 706 $(Generics.deriveRepresentable0 'NASShow1) # endif #endif ------------------------------------------------------------------------------- #if __GLASGOW_HASKELL__ >= 706 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 #endif ------------------------------------------------------------------------------- #if __GLASGOW_HASKELL__ >= 708 class NullaryClass where data NullaryData :: * instance NullaryClass where newtype NullaryData = NullaryCon Int deriving (Arbitrary, Show, Generic) $(deriveTextShow 'NullaryCon) #endif text-show-3.6/benchmarks/0000755000000000000000000000000013077013176013634 5ustar0000000000000000text-show-3.6/benchmarks/Bench.hs0000644000000000000000000001024413077013176015210 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) 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 ] ] ------------------------------------------------------------------------------- -- Tree-like ADTs ------------------------------------------------------------------------------- sampleGroup :: forall a b. NFData b => String -> (Int -> a) -> (a -> a -> a) -> a -> (a -> b) -> Benchmark sampleGroup title leaf branch empty showFun = 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) -- 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) text-show-3.6/shared/0000755000000000000000000000000013077013176012765 5ustar0000000000000000text-show-3.6/shared/TextShow/0000755000000000000000000000000013077013176014552 5ustar0000000000000000text-show-3.6/shared/TextShow/TH/0000755000000000000000000000000013077013176015065 5ustar0000000000000000text-show-3.6/shared/TextShow/TH/Names.hs0000644000000000000000000000603713077013176016472 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 ( #if MIN_VERSION_base(4,4,0) evtCloseValName, eventIsValName, fdKeyTypeName, uniqueTypeName, asInt64ValName, #endif #if MIN_VERSION_base(4,6,0) numberTypeName, #endif #if MIN_VERSION_base(4,8,0) giveGCStatsTypeName, doCostCentresTypeName, doHeapProfileTypeName, doTraceTypeName, #endif ) where #if MIN_VERSION_base(4,4,0) import Language.Haskell.TH.Syntax #endif #if MIN_VERSION_base(4,7,0) import Text.Read.Lex (Number) #endif #if MIN_VERSION_base(4,8,2) import GHC.RTS.Flags (GiveGCStats, DoCostCentres, DoHeapProfile, DoTrace) #endif ------------------------------------------------------------------------------- #if MIN_VERSION_base(4,4,0) -- | Creates a 'Name' for a value from the "GHC.Event.Internal" module. mkEventName_v :: String -> Name mkEventName_v = mkNameG_v "base" "GHC.Event.Internal" -- | 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,10,0) asInt64ValName = mkNameG_v "base" "GHC.Event.Unique" "asInt" # else asInt64ValName = mkNameG_v "base" "GHC.Event.Unique" "asInt64" # endif #endif #if MIN_VERSION_base(4,6,0) -- | The 'Name' of 'Number'. numberTypeName :: Name # if MIN_VERSION_base(4,7,0) numberTypeName = ''Number # else numberTypeName = mkNameG_tc "base" "Text.Read.Lex" "Number" # endif #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