text-show-2.1.1/0000755000000000000000000000000012575552406011656 5ustar0000000000000000text-show-2.1.1/text-show.cabal0000644000000000000000000003505512575552406014614 0ustar0000000000000000name: text-show version: 2.1.1 synopsis: Efficient conversion of values into Text description: @text-show@ offers a replacement for the @Show@ typeclass intended for use with @Text@ instead of @String@s. This package was created 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. If you don't know which one to use, use "TextShow.TH". 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-2015 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.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 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.Identity TextShow.Debug.Trace TextShow.Debug.Trace.Generic TextShow.Debug.Trace.TH TextShow.Generic TextShow.Data.Integral TextShow.Data.List TextShow.Data.Maybe TextShow.Data.Monoid TextShow.Data.Ord TextShow.Data.Proxy TextShow.Data.Ratio 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 other-modules: TextShow.Classes TextShow.Data.Typeable.Utils TextShow.FromStringTextShow TextShow.Instances TextShow.TH.Internal TextShow.TH.Names TextShow.Utils build-depends: array >= 0.3 && < 0.6 , base >= 4.3 && < 5 , base-compat >= 0.8.1 && < 1 , bytestring  >= 0.9 && < 0.11 , bytestring-builder , containers >= 0.1 && < 0.6 , generic-deriving >= 1.8 && < 2 , ghc-prim , integer-gmp , nats >= 0.1 && < 2 , semigroups >= 0.16.1 && < 1 , tagged >= 0.4.4 && < 1 , text >= 0.11.1 && < 1.3 , template-haskell >= 2.5 && < 2.12 , transformers >= 0.2.1 && < 0.5 , void >= 0.5 && < 1 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall include-dirs: include includes: inline.h , utils.h install-includes: inline.h , utils.h test-suite spec type: exitcode-stdio-1.0 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.Applicative 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.Identity Instances.Data.Monoid Instances.Data.Ord Instances.Data.Proxy Instances.Data.Text Instances.Data.Tuple Instances.Data.Typeable Instances.Data.Version Instances.Foreign.C.Types Instances.Foreign.Ptr Instances.FromStringTextShow Instances.Generic Instances.GHC.Generics Instances.Numeric.Natural Instances.System.Exit Instances.System.IO Instances.System.Posix.Types Instances.Text.Read Instances.Utils -- 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 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.IdentitySpec Spec.Data.IntegralSpec Spec.Data.ListSpec Spec.Data.MaybeSpec Spec.Data.MonoidSpec Spec.Data.OrdSpec Spec.Data.ProxySpec Spec.Data.RatioSpec 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.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 TransformersCompat build-depends: array >= 0.3 && < 0.6 , base >= 4.3 && < 5 , base-compat >= 0.8.2 && < 1 , base-orphans >= 0.4.2 && < 1 , bifunctors >= 5 && < 6 , bytestring  >= 0.9 && < 0.11 , bytestring-builder , generic-deriving >= 1.8.0 && < 2 , ghc-prim , hspec >= 2 && < 3 , nats >= 0.1 && < 2 , QuickCheck >= 2.5 && < 3 , quickcheck-instances >= 0.1 && < 0.4 , tagged >= 0.8.1 && < 1 , text >= 0.11.1 && < 1.3 , text-show == 2.1.1 , transformers >= 0.2.1 && < 0.5 , transformers-compat >= 0.3 && < 1 , void >= 0.5 && < 1 hs-source-dirs: tests default-language: Haskell2010 ghc-options: -Wall -threaded -rtsopts include-dirs: include includes: generic.h , overlap.h , utils.h install-includes: generic.h , overlap.h , utils.h text-show-2.1.1/Setup.hs0000644000000000000000000000005612575552406013313 0ustar0000000000000000import Distribution.Simple main = defaultMain text-show-2.1.1/README.md0000644000000000000000000000411712575552406013140 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. If you don't know which one to use, use `TextShow.TH`. text-show-2.1.1/CHANGELOG.md0000644000000000000000000004103212575552406013467 0ustar0000000000000000# 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-2.1.1/LICENSE0000644000000000000000000000276312575552406012673 0ustar0000000000000000Copyright (c) 2014-2015, 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-2.1.1/include/0000755000000000000000000000000012575552406013301 5ustar0000000000000000text-show-2.1.1/include/utils.h0000644000000000000000000000013212575552406014606 0ustar0000000000000000#ifndef UTILS_H #define UTILS_H #define OPEN_PRAGMA {-# #define CLOSE_PRAGMA #-} #endif text-show-2.1.1/include/overlap.h0000644000000000000000000000077312575552406015131 0ustar0000000000000000#ifndef OVERLAP_H #define OVERLAP_H #include "utils.h" #if __GLASGOW_HASKELL__ >= 710 # define __LANGUAGE_OVERLAPPING_INSTANCES__ # define __OVERLAPPABLE__ OPEN_PRAGMA OVERLAPPABLE CLOSE_PRAGMA # define __OVERLAPPING__ OPEN_PRAGMA OVERLAPPING CLOSE_PRAGMA # define __OVERLAPS__ OPEN_PRAGMA OVERLAPS CLOSE_PRAGMA #else # define __LANGUAGE_OVERLAPPING_INSTANCES__ OPEN_PRAGMA LANGUAGE OverlappingInstances CLOSE_PRAGMA # define __OVERLAPPABLE__ # define __OVERLAPPING__ # define __OVERLAPS__ #endif #endif text-show-2.1.1/include/inline.h0000644000000000000000000000030412575552406014725 0ustar0000000000000000#ifndef INLINE_H #define INLINE_H #include "utils.h" #if __GLASGOW_HASKELL__ > 702 # define INLINE_INST_FUN(F) OPEN_PRAGMA INLINE F CLOSE_PRAGMA #else # define INLINE_INST_FUN(F) #endif #endif text-show-2.1.1/include/generic.h0000644000000000000000000000047512575552406015074 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-2.1.1/tests/0000755000000000000000000000000012575552406013020 5ustar0000000000000000text-show-2.1.1/tests/TransformersCompat.hs0000644000000000000000000002774212575552406017221 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #else {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #endif {-| Module: TransformersCompat Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Defines the 'Show1' and 'Show2' classes for @String@s. This module will be removed once the next version of @transformers@/@transformers-compat@ is released. -} module TransformersCompat ( -- * Liftings of Prelude classes -- ** For unary constructors Show1(..), showsPrec1, -- ** For binary constructors Show2(..), showsPrec2, -- * Helper functions showsUnaryWith, showsBinaryWith, -- * Conversion between @Text-@ and @String@ @Show1@/@Show2@ FromStringShow1(..), FromTextShow1(..), FromStringShow2(..), FromTextShow2(..) ) where #include "inline.h" import Control.Applicative (Const(..)) import Data.Bifunctor (Bifunctor(..)) #if __GLASGOW_HASKELL__ >= 708 import Data.Data (Data, Typeable) #endif import Data.Functor.Identity (Identity(..)) #if __GLASGOW_HASKELL__ >= 702 import GHC.Generics (Generic) # if __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic1) # endif #else import qualified Generics.Deriving.TH as Generics #endif import Prelude () import Prelude.Compat import Text.Read (Read(..), readListPrecDefault) import TextShow (TextShow(showbPrec), TextShow1(..), TextShow2(..), FromStringShow(..), FromTextShow(..), showsToShowb, showbToShows, showbPrec1, showbPrec2) -- | Lifting of the 'Show' class to unary type constructors. class Show1 f where -- | Lift a 'showsPrec' function through the type constructor. showsPrecWith :: (Int -> a -> ShowS) -> Int -> f a -> ShowS -- | Lift the standard 'showsPrec' function through the type constructor. showsPrec1 :: (Show1 f, Show a) => Int -> f a -> ShowS showsPrec1 = showsPrecWith showsPrec -- | The 'TextShow1' instance for 'FromStringShow1' is based on its @String@ -- 'Show1' instance. That is, -- -- @ -- showbPrecWith sp p ('FromStringShow1' x) = -- 'showsToShowb' ('showsPrecWith' ('showbToShows' sp)) p x -- @ -- -- /Since: ?.?/ newtype FromStringShow1 f a = FromStringShow1 { fromStringShow1 :: f a } deriving ( Eq , Functor , Foldable #if __GLASGOW_HASKELL__ >= 702 , Generic # if __GLASGOW_HASKELL__ >= 706 , Generic1 # endif #endif , Ord , Show1 , Traversable #if __GLASGOW_HASKELL__ >= 708 , Data , Typeable #endif ) instance Read (f a) => Read (FromStringShow1 f a) where readPrec = FromStringShow1 <$> readPrec INLINE_INST_FUN(readPrec) readListPrec = readListPrecDefault INLINE_INST_FUN(readListPrec) instance (Show1 f, Show a) => TextShow (FromStringShow1 f a) where showbPrec = showbPrecWith (showsToShowb showsPrec) INLINE_INST_FUN(showbPrec) instance Show1 f => TextShow1 (FromStringShow1 f) where showbPrecWith sp p = showsToShowb (showsPrecWith $ showbToShows sp) p . fromStringShow1 INLINE_INST_FUN(showbPrecWith) instance (Show1 f, Show a) => Show (FromStringShow1 f a) where showsPrec = showsPrec1 INLINE_INST_FUN(showsPrec) -- | Lifting of the 'Show' class to binary type constructors. class Show2 f where -- | Lift 'showsPrec' functions through the type constructor. showsPrecWith2 :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> Int -> f a b -> ShowS -- | Lift the standard 'showsPrec' function through the type constructor. showsPrec2 :: (Show2 f, Show a, Show b) => Int -> f a b -> ShowS showsPrec2 = showsPrecWith2 showsPrec showsPrec -- | The @String@ 'Show1' instance for 'FromTextShow1' is based on its -- 'TextShow1' instance. That is, -- -- @ -- showsPrecWith sp p ('FromTextShow1' x) = -- 'showbToShows' ('showbPrecWith' ('showsToShowb' sp)) p x -- @ -- -- /Since: ?.?/ newtype FromTextShow1 f a = FromTextShow1 { fromTextShow1 :: f a } deriving ( Eq , Functor , Foldable #if __GLASGOW_HASKELL__ >= 702 , Generic # if __GLASGOW_HASKELL__ >= 706 , Generic1 # endif #endif , Ord , TextShow1 , Traversable #if __GLASGOW_HASKELL__ >= 708 , Data , Typeable #endif ) instance Read (f a) => Read (FromTextShow1 f a) where readPrec = FromTextShow1 <$> readPrec INLINE_INST_FUN(readPrec) readListPrec = readListPrecDefault INLINE_INST_FUN(readListPrec) instance (TextShow1 f, TextShow a) => Show (FromTextShow1 f a) where showsPrec = showsPrecWith (showbToShows showbPrec) INLINE_INST_FUN(showsPrec) instance TextShow1 f => Show1 (FromTextShow1 f) where showsPrecWith sp p = showbToShows (showbPrecWith $ showsToShowb sp) p . fromTextShow1 INLINE_INST_FUN(showsPrecWith) instance (TextShow1 f, TextShow a) => TextShow (FromTextShow1 f a) where showbPrec = showbPrec1 INLINE_INST_FUN(showbPrec) -- | The 'TextShow2' instance for 'FromStringShow2' is based on its @String@ -- 'Show2' instance. That is, -- -- @ -- showbPrecWith2 sp1 sp2 p ('FromStringShow2' x) = -- 'showsToShowb' ('showsPrecWith2' ('showbToShows' sp1) ('showbToShows' sp2)) p x -- @ -- -- /Since: ?.?/ newtype FromStringShow2 f a b = FromStringShow2 { fromStringShow2 :: f a b } deriving ( Eq , Functor , Foldable #if __GLASGOW_HASKELL__ >= 702 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #endif , Ord , Show2 , Traversable #if __GLASGOW_HASKELL__ >= 708 , Data , Typeable #endif ) instance Bifunctor f => Bifunctor (FromStringShow2 f) where bimap f g = FromStringShow2 . bimap f g . fromStringShow2 INLINE_INST_FUN(bimap) instance Read (f a b) => Read (FromStringShow2 f a b) where readPrec = FromStringShow2 <$> readPrec INLINE_INST_FUN(readPrec) readListPrec = readListPrecDefault INLINE_INST_FUN(readListPrec) instance (Show2 f, Show a, Show b) => TextShow (FromStringShow2 f a b) where showbPrec = showbPrecWith (showsToShowb showsPrec) INLINE_INST_FUN(showbPrec) instance (Show2 f, Show a) => TextShow1 (FromStringShow2 f a) where showbPrecWith = showbPrecWith2 (showsToShowb showsPrec) INLINE_INST_FUN(showbPrecWith) instance Show2 f => TextShow2 (FromStringShow2 f) where showbPrecWith2 sp1 sp2 p = showsToShowb (showsPrecWith2 (showbToShows sp1) (showbToShows sp2)) p . fromStringShow2 INLINE_INST_FUN(showbPrecWith2) instance (Show2 f, Show a, Show b) => Show (FromStringShow2 f a b) where showsPrec = showsPrec2 INLINE_INST_FUN(showsPrec) instance (Show2 f, Show a) => Show1 (FromStringShow2 f a) where showsPrecWith = showsPrecWith2 showsPrec INLINE_INST_FUN(showsPrecWith) -- | The @String@ 'Show2' instance for 'FromTextShow2' is based on its -- 'TextShow2' instance. That is, -- -- @ -- showsPrecWith2 sp1 sp2 p ('FromTextShow2' x) = -- 'showbToShows' ('showbPrecWith2' ('showsToShowb' sp1) ('showsToShowb' sp2)) p x -- @ -- -- /Since: ?.?/ newtype FromTextShow2 f a b = FromTextShow2 { fromTextShow2 :: f a b } deriving ( Eq , Functor , Foldable #if __GLASGOW_HASKELL__ >= 702 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #endif , Ord , TextShow2 , Traversable #if __GLASGOW_HASKELL__ >= 708 , Data , Typeable #endif ) instance Bifunctor f => Bifunctor (FromTextShow2 f) where bimap f g = FromTextShow2 . bimap f g . fromTextShow2 INLINE_INST_FUN(bimap) instance Read (f a b) => Read (FromTextShow2 f a b) where readPrec = FromTextShow2 <$> readPrec INLINE_INST_FUN(readPrec) readListPrec = readListPrecDefault INLINE_INST_FUN(readListPrec) instance (TextShow2 f, TextShow a, TextShow b) => Show (FromTextShow2 f a b) where showsPrec = showsPrecWith (showbToShows showbPrec) INLINE_INST_FUN(showsPrec) instance (TextShow2 f, TextShow a) => Show1 (FromTextShow2 f a) where showsPrecWith = showsPrecWith2 (showbToShows showbPrec) INLINE_INST_FUN(showsPrecWith) instance TextShow2 f => Show2 (FromTextShow2 f) where showsPrecWith2 sp1 sp2 p = showbToShows (showbPrecWith2 (showsToShowb sp1) (showsToShowb sp2)) p . fromTextShow2 INLINE_INST_FUN(showsPrecWith2) instance (TextShow2 f, TextShow a, TextShow b) => TextShow (FromTextShow2 f a b) where showbPrec = showbPrec2 INLINE_INST_FUN(showbPrec) instance (TextShow2 f, TextShow a) => TextShow1 (FromTextShow2 f a) where showbPrecWith = showbPrecWith2 showbPrec INLINE_INST_FUN(showbPrecWith) ------------------------------------------------------------------------------- -- | @'showsUnaryWith' sp n d x@ produces the string representation of a -- unary data constructor with name @n@ and argument @x@, in precedence -- context @d@. showsUnaryWith :: (Int -> a -> ShowS) -> String -> Int -> a -> ShowS showsUnaryWith sp name d x = showParen (d > 10) $ showString name . showChar ' ' . sp 11 x -- | @'showsBinaryWith' sp1 sp2 n d x y@ produces the string -- representation of a binary data constructor with name @n@ and arguments -- @x@ and @y@, in precedence context @d@. showsBinaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> String -> Int -> a -> b -> ShowS showsBinaryWith sp1 sp2 name d x y = showParen (d > 10) $ showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y ------------------------------------------------------------------------------- instance Show a => Show1 ((,) a) where showsPrecWith = showsPrecWith2 showsPrec instance Show a => Show1 (Either a) where showsPrecWith = showsPrecWith2 showsPrec instance Show a => Show1 (Const a) where showsPrecWith = showsPrecWith2 showsPrec instance Show1 Maybe where showsPrecWith _ _ Nothing = showString "Nothing" showsPrecWith sp d (Just x) = showsUnaryWith sp "Just" d x instance Show1 [] where showsPrecWith _ _ [] = showString "[]" showsPrecWith sp _ (x:xs) = showChar '[' . sp 0 x . showl xs where showl [] = showChar ']' showl (y:ys) = showChar ',' . sp 0 y . showl ys instance Show1 Identity where showsPrecWith sp d (Identity x) = showsUnaryWith sp "Identity" d x instance Show2 (,) where showsPrecWith2 sp1 sp2 _ (x, y) = showChar '(' . sp1 0 x . showChar ',' . sp2 0 y . showChar ')' instance Show2 Either where showsPrecWith2 sp1 _ d (Left x) = showsUnaryWith sp1 "Left" d x showsPrecWith2 _ sp2 d (Right x) = showsUnaryWith sp2 "Right" d x instance Show2 Const where showsPrecWith2 sp _ d (Const x) = showsUnaryWith sp "Const" d x instance (Show a, Show b, Show c) => Show2 ((,,,,) a b c) where showsPrecWith2 sp1 sp2 _ (a, b, c, d, e) = showChar '(' . shows a . showChar ',' . shows b . showChar ',' . shows c . showChar ',' . sp1 0 d . showChar ',' . sp2 0 e . showChar ')' -- TODO: Move these instance into text-show itself once transformers is updated instance Show1 FromStringShow where showsPrecWith sp p = sp p . fromStringShow INLINE_INST_FUN(showsPrecWith) instance Show1 FromTextShow where showsPrecWith sp p = showbToShows (showsToShowb sp) p . fromTextShow INLINE_INST_FUN(showsPrecWith) ------------------------------------------------------------------------------- #if __GLASGOW_HASKELL__ < 702 $(Generics.deriveAll ''FromStringShow1) $(Generics.deriveAll ''FromStringShow2) #endif text-show-2.1.1/tests/Spec.hs0000644000000000000000000000005412575552406014245 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} text-show-2.1.1/tests/Derived/0000755000000000000000000000000012575552406014402 5ustar0000000000000000text-show-2.1.1/tests/Derived/DataFamilies.hs0000644000000000000000000000603712575552406017267 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #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-2015 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__ >= 708 , NullaryClass(..) , NullaryData(..) #endif ) where #include "generic.h" #if __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic) # if defined(__LANGUAGE_DERIVE_GENERIC1__) import GHC.Generics (Generic1) # endif #endif import GHC.Show (appPrec, appPrec1, showSpace) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..), oneof) #if MIN_VERSION_template_haskell(2,7,0) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) #endif import TransformersCompat (Show1(..), Show2(..)) ------------------------------------------------------------------------------- data family NotAllShow #if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKEL__ < 710 a b c d :: * #else w x y z :: * #endif 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 = oneof [ NASShow1 <$> arbitrary <*> arbitrary , NASShow2 <$> arbitrary ] instance (Show b, Show c) => Show1 (NotAllShow Int b c) where showsPrecWith = showsPrecWith2 showsPrec instance Show b => Show2 (NotAllShow Int b) where showsPrecWith2 sp1 _ p (NASShow1 c b) = showParen (p > appPrec) $ showString "NASShow1 " . sp1 appPrec1 c . showSpace . showsPrec appPrec1 b showsPrecWith2 _ sp2 p (NASShow2 d) = showParen (p > appPrec) $ showString "NASShow2 " . sp2 appPrec1 d #if MIN_VERSION_template_haskell(2,7,0) $(deriveTextShow 'NASShow1) $(deriveTextShow1 'NASShow2) $(deriveTextShow2 'NASShow1) #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-2.1.1/tests/Derived/Records.hs0000644000000000000000000000735012575552406016344 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #endif {-| Module: Derived.Records Copyright: (C) 2014-2015 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 __GLASGOW_HASKELL__ >= 702 import GHC.Generics (Generic) # if defined(__LANGUAGE_DERIVE_GENERIC1__) import GHC.Generics (Generic1) # endif #endif import GHC.Show (showSpace) #if __GLASGOW_HASKELL__ < 711 import GHC.Show (appPrec) #endif import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..), oneof) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) import TransformersCompat (Show1(..), Show2(..)) ------------------------------------------------------------------------------- infixl 4 :@: data TyCon a b = TyConPrefix { tc1 :: a, tc2 :: b } | (:@:) { tc3 :: b, tc4 :: a } deriving ( Show #if __GLASGOW_HASKELL__ >= 702 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #endif ) ------------------------------------------------------------------------------- data family TyFamily #if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710 a b :: * #else y z :: * #endif infixl 4 :!: data instance TyFamily a b = TyFamilyPrefix { tf1 :: a, tf2 :: b } | (:!:) { tf3 :: b, tf4 :: 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 = oneof [ TyConPrefix <$> arbitrary <*> arbitrary , (:@:) <$> arbitrary <*> arbitrary ] instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamily a b) where arbitrary = oneof [ TyFamilyPrefix <$> arbitrary <*> arbitrary , (:!:) <$> arbitrary <*> arbitrary ] ------------------------------------------------------------------------------- instance Show a => Show1 (TyCon a) where showsPrecWith = showsPrecWith2 showsPrec instance Show2 TyCon where showsPrecWith2 sp1 sp2 p (TyConPrefix a b) = showsRecord sp1 sp2 "TyConPrefix" "tc1" "tc2" p a b showsPrecWith2 sp1 sp2 p (a :@: b) = showsRecord sp2 sp1 "(:@:)" "tc3" "tc4" p a b instance Show a => Show1 (TyFamily a) where showsPrecWith = showsPrecWith2 showsPrec instance Show2 TyFamily where showsPrecWith2 sp1 sp2 p (TyFamilyPrefix a b) = showsRecord sp1 sp2 "TyFamilyPrefix" "tf1" "tf2" p a b showsPrecWith2 sp1 sp2 p (a :!: b) = showsRecord sp2 sp1 "(:!:)" "tf3" "tf4" p a b showsRecord :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> String -> String -> String -> Int -> a -> b -> ShowS showsRecord sp1 sp2 con rec1 rec2 _p a b = #if __GLASGOW_HASKELL__ < 711 showParen (_p > appPrec) $ #endif showString con . showSpace . showChar '{' . showString rec1 . showString " = " . sp1 0 a . showString ", " . showString rec2 . showString " = " . sp2 0 b . showChar '}' ------------------------------------------------------------------------------- $(deriveTextShow ''TyCon) $(deriveTextShow1 ''TyCon) $(deriveTextShow2 ''TyCon) #if MIN_VERSION_template_haskell(2,7,0) $(deriveTextShow 'TyFamilyPrefix) $(deriveTextShow1 '(:!:)) $(deriveTextShow2 'TyFamilyPrefix) #endif text-show-2.1.1/tests/Derived/RankNTypes.hs0000644000000000000000000000766112575552406017006 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-2015 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 Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) import TextShow (Show(..), Show1(..), Show2(..)) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2, makeShowbPrec, makeShowbPrecWith, makeShowbPrecWith2) import TransformersCompat (Show1(..), Show2(..), showsUnaryWith, showsBinaryWith) ------------------------------------------------------------------------------- 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 #if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710 a b :: * #else x y :: * #endif 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 ------------------------------------------------------------------------------- -- There's so much rank-n voodoo going on that we can't have a more generalized -- Arbitrary instances. Oh well, this is close enough. instance Arbitrary (TyCon Int Int) where arbitrary = do i1 <- arbitrary i2 <- arbitrary pure $ TyCon (Tagged2 i1) (Tagged2 i2) instance Arbitrary (TyFamily Int Int) where arbitrary = do i1 <- arbitrary i2 <- arbitrary pure $ TyFamily (Tagged2 i1) (Tagged2 i2) ------------------------------------------------------------------------------- instance Show a => Show1 (TyCon a) where showsPrecWith = showsPrecWith2 showsPrec instance Show2 TyCon where showsPrecWith2 sp1 sp2 p (TyCon b a) = showsForall sp1 sp2 "TyCon" p b a instance Show a => Show1 (TyFamily a) where showsPrecWith = showsPrecWith2 showsPrec instance Show2 TyFamily where showsPrecWith2 sp1 sp2 p (TyFamily b a) = showsForall sp1 sp2 "TyFamily" p b a showsForall :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> String -> Int -> (forall a. Tagged2 a Int b) -> (forall b. Tagged2 b a a) -> ShowS showsForall sp1 sp2 name p b a = showsBinaryWith (showsPrecWith2 showsPrec sp2) (showsPrecWith2 sp1 sp1) name p b a ------------------------------------------------------------------------------- $(deriveShow ''TyCon) $(deriveShow1 ''TyCon) $(deriveShow2 ''TyCon) #if MIN_VERSION_template_haskell(2,7,0) $(deriveShow 'TyFamily) $(deriveShow1 'TyFamily) $(deriveShow2 'TyFamily) #endif ------------------------------------------------------------------------------- $(return []) instance TextShow1 (Tagged2 s t) where showsPrecWith sp p (Tagged2 b) = showsUnaryWith sp "Tagged2" p b instance TextShow2 (Tagged2 s) where showsPrecWith2 _ = showsPrecWith instance TextShow c => TextShow (Tagged2 s t c) where showbPrec = $(makeShowbPrec ''Tagged2) instance TextShow1 (Tagged2 s t) where showbPrecWith = $(makeShowbPrecWith ''Tagged2) instance TextShow2 (Tagged2 s) where showbPrecWith2 = $(makeShowbPrecWith2 ''Tagged2) text-show-2.1.1/tests/Derived/PolyKinds.hs0000644000000000000000000002517712575552406016666 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif {-| Module: Derived.PolyKinds Copyright: (C) 2014-2015 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" #if __GLASGOW_HASKELL__ >= 702 import GHC.Generics (Generic) # if defined(__LANGUAGE_DERIVE_GENERIC1__) import GHC.Generics (Generic1) # endif #else import qualified Generics.Deriving.TH as Generics (deriveAll) #endif import GHC.Show (appPrec, appPrec1, showSpace) import Test.QuickCheck (Arbitrary) import TextShow (TextShow(..), TextShow1(..), TextShow2(..)) import TextShow.TH (deriveTextShow2, makeShowbPrec, makeShowbPrecWith, makeShowbPrecWith2) import TransformersCompat (Show1(..), Show2(..), showsUnaryWith) ------------------------------------------------------------------------------- newtype TyConCompose f g h j k a b = TyConCompose (f (g (j a) (k a)) (h (j a) (k 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 = TyConProxy () 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__ >= 708 && __GLASGOW_HASKELL__ < 710 (f :: k1 -> k2 -> *) (g :: k3 -> k4 -> k1) (h :: k3 -> k4 -> k2) (j :: k5 -> k3) (k :: k5 -> k4) (a :: k5) (b :: k5) #elif __GLASGOW_HASKELL__ >= 706 (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__ >= 708 && __GLASGOW_HASKELL__ < 710 (a :: k1) (b :: k2) #elif __GLASGOW_HASKELL__ >= 706 (x :: k1) (y :: k2) #else (x :: *) (y :: *) #endif :: * newtype instance TyFamilyProxy a b = TyFamilyProxy () deriving ( Arbitrary , Show #if __GLASGOW_HASKELL__ >= 706 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #endif ) ------------------------------------------------------------------------------- data family TyFamilyReallyHighKinds #if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710 (f :: k1 -> k2 -> k3 -> k4 -> k5 -> *) (a :: k1) (b :: k2) (c :: k3) (d :: k4) (e :: k5) #elif __GLASGOW_HASKELL__ >= 706 (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 ) ------------------------------------------------------------------------------- instance (Show1 (f (g (j a) (k a))), Show1 (h (j a)), Show1 k) => Show1 (TyConCompose f g h j k a) where showsPrecWith sp p (TyConCompose x) = showsPrecCompose sp "TyConCompose" p x instance (Show2 f, Show2 g, Show2 h, Show1 j, Show1 k) => Show2 (TyConCompose f g h j k) where showsPrecWith2 sp1 sp2 p (TyConCompose x) = showsPrecCompose2 sp1 sp2 "TyConCompose" p x instance Show1 (TyConProxy (a :: *)) where showsPrecWith = showsPrecWith2 undefined instance Show2 TyConProxy where showsPrecWith2 _ _ p (TyConProxy x) = showParen (p > appPrec) $ showString "TyConProxy " . showsPrec appPrec1 x instance Show1 (f a b c d) => Show1 (TyConReallyHighKinds f a b c d) where showsPrecWith sp p (TyConReallyHighKinds x) = showsUnaryWith (showsPrecWith sp) "TyConReallyHighKinds" p x instance Show2 (f a b c) => Show2 (TyConReallyHighKinds f a b c) where showsPrecWith2 sp1 sp2 p (TyConReallyHighKinds x) = showsUnaryWith (showsPrecWith2 sp1 sp2) "TyConReallyHighKinds" p x instance (Show1 (f (g (j a) (k a))), Show1 (h (j a)), Show1 k) => Show1 (TyFamilyCompose f g h j k a) where showsPrecWith sp p (TyFamilyCompose x) = showsPrecCompose sp "TyFamilyCompose" p x instance (Show2 f, Show2 g, Show2 h, Show1 j, Show1 k) => Show2 (TyFamilyCompose f g h j k) where showsPrecWith2 sp1 sp2 p (TyFamilyCompose x) = showsPrecCompose2 sp1 sp2 "TyFamilyCompose" p x instance Show1 (TyFamilyProxy (a :: *)) where showsPrecWith = showsPrecWith2 undefined instance Show2 TyFamilyProxy where showsPrecWith2 _ _ p (TyFamilyProxy x) = showParen (p > appPrec) $ showString "TyFamilyProxy " . showsPrec appPrec1 x instance Show1 (f a b c d) => Show1 (TyFamilyReallyHighKinds f a b c d) where showsPrecWith sp p (TyFamilyReallyHighKinds x) = showsUnaryWith (showsPrecWith sp) "TyFamilyReallyHighKinds" p x instance Show2 (f a b c) => Show2 (TyFamilyReallyHighKinds f a b c) where showsPrecWith2 sp1 sp2 p (TyFamilyReallyHighKinds x) = showsUnaryWith (showsPrecWith2 sp1 sp2) "TyFamilyReallyHighKinds" p x showsPrecCompose :: (Show1 (f (g (j a) (k a))), Show1 (h (j a)), Show1 k) => (Int -> b -> ShowS) -> String -> Int -> f (g (j a) (k a)) (h (j a) (k b)) -> ShowS showsPrecCompose sp name p x = showParen (p > appPrec) $ showString name . showSpace . showsPrecWith (showsPrecWith (showsPrecWith sp)) appPrec1 x showsPrecCompose2 :: (Show2 f, Show2 g, Show2 h, Show1 j, Show1 k) => (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> String -> Int -> f (g (j a) (k a)) (h (j a) (k b)) -> ShowS showsPrecCompose2 sp1 sp2 name p x = showParen (p > appPrec) $ showString name . showSpace . showsPrecWith2 (showsPrecWith2 (showsPrecWith sp1) (showsPrecWith sp1)) (showsPrecWith2 (showsPrecWith sp1) (showsPrecWith sp2)) appPrec1 x ------------------------------------------------------------------------------- $(return []) instance TextShow (f (g (j a) (k a)) (h (j a) (k b))) => TextShow (TyConCompose f g h j k a b) where showbPrec = $(makeShowbPrec ''TyConCompose) instance (TextShow1 (f (g (j a) (k a))), TextShow1 (h (j a)), TextShow1 k) => TextShow1 (TyConCompose f g h j k a) where showbPrecWith = $(makeShowbPrecWith ''TyConCompose) $(deriveTextShow2 ''TyConCompose) instance TextShow (TyConProxy a b) where showbPrec = $(makeShowbPrec ''TyConProxy) instance TextShow1 (TyConProxy a) where showbPrecWith = $(makeShowbPrecWith ''TyConProxy) $(deriveTextShow2 ''TyConProxy) instance TextShow (f a b c d e) => TextShow (TyConReallyHighKinds f a b c d e) where showbPrec = $(makeShowbPrec ''TyConReallyHighKinds) instance TextShow1 (f a b c d) => TextShow1 (TyConReallyHighKinds f a b c d) where showbPrecWith = $(makeShowbPrecWith ''TyConReallyHighKinds) instance TextShow2 (f a b c) => TextShow2 (TyConReallyHighKinds f a b c) where showbPrecWith2 = $(makeShowbPrecWith2 ''TyConReallyHighKinds) #if MIN_VERSION_template_haskell(2,7,0) 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 showbPrecWith = $(makeShowbPrecWith 'TyFamilyCompose) $(deriveTextShow2 'TyFamilyCompose) instance TextShow (TyFamilyProxy a b) where showbPrec = $(makeShowbPrec 'TyFamilyProxy) instance TextShow1 (TyFamilyProxy a) where showbPrecWith = $(makeShowbPrecWith 'TyFamilyProxy) $(deriveTextShow2 'TyFamilyProxy) instance TextShow (f a b c d e) => TextShow (TyFamilyReallyHighKinds f a b c d e) where showbPrec = $(makeShowbPrec 'TyFamilyReallyHighKinds) instance TextShow1 (f a b c d) => TextShow1 (TyFamilyReallyHighKinds f a b c d) where showbPrecWith = $(makeShowbPrecWith 'TyFamilyReallyHighKinds) instance TextShow2 (f a b c) => TextShow2 (TyFamilyReallyHighKinds f a b c) where showbPrecWith2 = $(makeShowbPrecWith2 'TyFamilyReallyHighKinds) #endif #if __GLASGOW_HASKELL__ < 702 $(Generics.deriveAll ''TyConCompose) $(Generics.deriveAll ''TyConProxy) $(Generics.deriveAll ''TyConReallyHighKinds) #endif text-show-2.1.1/tests/Derived/ExistentialQuantification.hs0000644000000000000000000001411612575552406022131 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-| Module: Derived.ExistentialQuantification Copyright: (C) 2014-2015 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 GHC.Show (appPrec, appPrec1, showSpace) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..), Gen, oneof) import TextShow (TextShow) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) import TransformersCompat (Show1(..), Show2(..), showsBinaryWith) ------------------------------------------------------------------------------- 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 TyConTypeRefinement :: Int -> z -> TyCon Int z Int 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 ------------------------------------------------------------------------------- data family TyFamily #if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710 a b c d :: * #else w x y z :: * #endif 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 TyFamilyTypeRefinement :: Int -> z -> TyFamily Int z Int 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 ------------------------------------------------------------------------------- instance (a ~ Int, b ~ Int, c ~ Int, d ~ Int) => Arbitrary (TyCon a b c d) where arbitrary = oneof [ TyConClassConstraints <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary , TyConEqualityConstraints <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary , TyConTypeRefinement <$> arbitrary <*> arbitrary , 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 , TyFamilyTypeRefinement <$> arbitrary <*> arbitrary , TyFamilyForalls <$> (arbitrary :: Gen Int) <*> (arbitrary :: Gen Int) <*> arbitrary <*> arbitrary ] ------------------------------------------------------------------------------- deriving instance (Show a, Show b, Show c, Show d) => Show (TyCon a b c d) instance (Show a, Show b, Show c) => Show1 (TyCon a b c) where showsPrecWith = showsPrecWith2 showsPrec instance (Show a, Show b) => Show2 (TyCon a b) where showsPrecWith2 sp1 sp2 p (TyConClassConstraints a b c d) = showsFour sp1 sp2 "TyConClassConstraints" p a b c d showsPrecWith2 sp1 sp2 p (TyConEqualityConstraints a b c d) = showsFour sp1 sp2 "TyConEqualityConstraints" p a b c d showsPrecWith2 _ sp2 p (TyConTypeRefinement i d) = showsBinaryWith showsPrec sp2 "TyConTypeRefinement" p i d showsPrecWith2 sp1 sp2 p (TyConForalls p' q d c) = showsFour sp2 sp1 "TyConForalls" p p' q d c deriving instance (Show a, Show b, Show c, Show d) => Show (TyFamily a b c d) instance (Show a, Show b, Show c) => Show1 (TyFamily a b c) where showsPrecWith = showsPrecWith2 showsPrec instance (Show a, Show b) => Show2 (TyFamily a b) where showsPrecWith2 sp1 sp2 p (TyFamilyClassConstraints a b c d) = showsFour sp1 sp2 "TyFamilyClassConstraints" p a b c d showsPrecWith2 sp1 sp2 p (TyFamilyEqualityConstraints a b c d) = showsFour sp1 sp2 "TyFamilyEqualityConstraints" p a b c d showsPrecWith2 _ sp2 p (TyFamilyTypeRefinement i d) = showsBinaryWith showsPrec sp2 "TyFamilyTypeRefinement" p i d showsPrecWith2 sp1 sp2 p (TyFamilyForalls p' q d c) = showsFour sp2 sp1 "TyFamilyForalls" p p' q d c showsFour :: (Show a, Show b) => (Int -> c -> ShowS) -> (Int -> d -> ShowS) -> String -> Int -> a -> b -> c -> d -> ShowS showsFour sp1 sp2 name p a b c d = showParen (p > appPrec) $ showString name . showSpace . showsPrec appPrec1 a . showSpace . showsPrec appPrec1 b . showSpace . sp1 appPrec1 c . showSpace . sp2 appPrec1 d ------------------------------------------------------------------------------- $(deriveTextShow ''TyCon) $(deriveTextShow1 ''TyCon) $(deriveTextShow2 ''TyCon) #if MIN_VERSION_template_haskell(2,7,0) $(deriveTextShow 'TyFamilyClassConstraints) $(deriveTextShow1 'TyFamilyEqualityConstraints) $(deriveTextShow2 'TyFamilyTypeRefinement) #endif text-show-2.1.1/tests/Derived/MagicHash.hs0000644000000000000000000000327412575552406016570 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-| Module: Derived.MagicHash Copyright: (C) 2014-2015 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 import GHC.Exts import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) import TextShow.TH (deriveTextShow) ------------------------------------------------------------------------------- data TyCon# = TyCon# { tcInt# :: Int# , tcFloat# :: Float# , tcDouble# :: Double# , tcChar# :: Char# , tcWord# :: Word# } deriving Show $(deriveTextShow ''TyCon#) ------------------------------------------------------------------------------- data family TyFamily# data instance TyFamily# = TyFamily# { tfInt# :: Int# , tfFloat# :: Float# , tfDouble# :: Double# , tfChar# :: Char# , tfWord# :: Word# } deriving Show #if MIN_VERSION_template_haskell(2,7,0) $(deriveTextShow 'TyFamily#) #endif ------------------------------------------------------------------------------- instance Arbitrary TyCon# where arbitrary = do I# i# <- arbitrary F# f# <- arbitrary D# d# <- arbitrary C# c# <- arbitrary W# w# <- arbitrary pure $ TyCon# i# f# d# c# w# instance Arbitrary TyFamily# where arbitrary = do I# i# <- arbitrary F# f# <- arbitrary D# d# <- arbitrary C# c# <- arbitrary W# w# <- arbitrary pure $ TyFamily# i# f# d# c# w# text-show-2.1.1/tests/Derived/Infix.hs0000644000000000000000000001607712575552406016026 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #endif {-| Module: Derived.Infix Copyright: (C) 2014-2015 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 __GLASGOW_HASKELL__ >= 702 import GHC.Generics (Generic) # if defined(__LANGUAGE_DERIVE_GENERIC1__) import GHC.Generics (Generic1) # endif #endif import GHC.Show (appPrec, appPrec1, showSpace) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..), oneof) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) import TransformersCompat (Show1(..), Show2(..), showsBinaryWith) ------------------------------------------------------------------------------- infixl 3 :!: infix 4 :@: infixr 5 `TyConPlain` data TyConPlain a b = (:!:) a b | a :@: b | a `TyConPlain` b deriving ( Show #if __GLASGOW_HASKELL__ >= 702 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , 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 # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #endif ) ------------------------------------------------------------------------------- data family TyFamilyPlain #if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710 a b :: * #else y z :: * #endif infixl 3 :#: infix 4 :$: infixr 5 `TyFamilyPlain` data instance TyFamilyPlain a b = (:#:) a b | a :$: b | a `TyFamilyPlain` b deriving ( Show #if __GLASGOW_HASKELL__ >= 706 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #endif ) ------------------------------------------------------------------------------- data family TyFamilyGADT #if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710 a b :: * #else y z :: * #endif 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 = oneof (map pure [(:!:), (:@:), TyConPlain]) <*> arbitrary <*> arbitrary instance (Arbitrary a, Arbitrary b) => Arbitrary (TyConGADT a b) where arbitrary = oneof [ pure (:.) , pure (:..) , flip (flip . (:...)) <$> arbitrary , pure (:....) ] <*> arbitrary <*> arbitrary instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamilyPlain a b) where arbitrary = oneof (map pure [(:#:), (:$:), TyFamilyPlain]) <*> arbitrary <*> arbitrary instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamilyGADT a b) where arbitrary = oneof [ pure (:*) , pure (:**) , flip (flip . (:***)) <$> arbitrary , pure (:****) ] <*> arbitrary <*> arbitrary ------------------------------------------------------------------------------- instance Show a => Show1 (TyConPlain a) where showsPrecWith = showsPrecWith2 showsPrec instance Show2 TyConPlain where showsPrecWith2 sp1 sp2 p (a :!: b) = showsBinaryWith sp1 sp2 "(:!:)" p a b showsPrecWith2 sp1 sp2 p (a :@: b) = showsInfix sp1 sp2 ":@:" p 4 a b showsPrecWith2 sp1 sp2 p (TyConPlain a b) = showsInfix sp1 sp2 "`TyConPlain`" p 5 a b instance Show a => Show1 (TyConGADT a) where showsPrecWith = showsPrecWith2 showsPrec instance Show2 TyConGADT where showsPrecWith2 sp1 sp2 p (a :. b) = showsInfix sp1 sp2 ":." p 1 a b showsPrecWith2 sp1 sp2 p (a :.. b) = showsBinaryWith sp1 sp2 "(:..)" p a b showsPrecWith2 sp1 sp2 p ((:...) a b i) = showsTernaryWith sp1 sp2 "(:...)" p a b i showsPrecWith2 sp1 sp2 p (a :.... b) = showsBinaryWith sp1 sp2 "(:....)" p a b instance Show a => Show1 (TyFamilyPlain a) where showsPrecWith = showsPrecWith2 showsPrec instance Show2 TyFamilyPlain where showsPrecWith2 sp1 sp2 p (a :#: b) = showsBinaryWith sp1 sp2 "(:#:)" p a b showsPrecWith2 sp1 sp2 p (a :$: b) = showsInfix sp1 sp2 ":$:" p 4 a b showsPrecWith2 sp1 sp2 p (TyFamilyPlain a b) = showsInfix sp1 sp2 "`TyFamilyPlain`" p 5 a b instance Show a => Show1 (TyFamilyGADT a) where showsPrecWith = showsPrecWith2 showsPrec instance Show2 TyFamilyGADT where showsPrecWith2 sp1 sp2 p (a :* b) = showsInfix sp1 sp2 ":*" p 1 a b showsPrecWith2 sp1 sp2 p (a :** b) = showsBinaryWith sp1 sp2 "(:**)" p a b showsPrecWith2 sp1 sp2 p ((:***) a b i) = showsTernaryWith sp1 sp2 "(:***)" p a b i showsPrecWith2 sp1 sp2 p (a :**** b) = showsBinaryWith sp1 sp2 "(:****)" p a b showsInfix :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> String -> Int -> Int -> a -> b -> ShowS showsInfix sp1 sp2 name p infixPrec a b = showParen (p > infixPrec) $ sp1 (infixPrec + 1) a . showSpace . showString name . showSpace . sp2 (infixPrec + 1) b showsTernaryWith :: (Int -> a -> ShowS) -> (Int -> b -> ShowS) -> String -> Int -> a -> b -> Int -> ShowS showsTernaryWith sp1 sp2 name p a b i = showParen (p > appPrec) $ showString name . showSpace . sp1 appPrec1 a . showSpace . sp2 appPrec1 b . showSpace . showsPrec appPrec1 i ------------------------------------------------------------------------------- $(deriveTextShow ''TyConPlain) $(deriveTextShow1 ''TyConPlain) $(deriveTextShow2 ''TyConPlain) $(deriveTextShow ''TyConGADT) $(deriveTextShow1 ''TyConGADT) $(deriveTextShow2 ''TyConGADT) #if MIN_VERSION_template_haskell(2,7,0) $(deriveTextShow '(:#:)) $(deriveTextShow1 '(:$:)) $(deriveTextShow2 'TyFamilyPlain) $(deriveTextShow '(:*)) $(deriveTextShow1 '(:***)) $(deriveTextShow2 '(:****)) #endif text-show-2.1.1/tests/Derived/DatatypeContexts.hs0000644000000000000000000000651712575552406020252 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DatatypeContexts #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -w #-} {-| Module: Derived.DatatypeContexts Copyright: (C) 2014-2015 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 GHC.Show (appPrec, appPrec1, showSpace) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) import TextShow (TextShow(..), TextShow1(..), TextShow2(..)) import TextShow.TH (makeShowbPrec, makeShowbPrecWith, makeShowbPrecWith2) import TransformersCompat (Show1(..), Show2(..)) ------------------------------------------------------------------------------- data Ord a => TyCon a b c = TyCon a b c deriving Show ------------------------------------------------------------------------------- data family TyFamily #if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710 a b c :: * #else x y z :: * #endif 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 ------------------------------------------------------------------------------- instance (Ord a, Show a, Show b) => Show1 (TyCon a b) where showsPrecWith = showsPrecWith2 showsPrec instance (Ord a, Show a) => Show2 (TyCon a) where showsPrecWith2 sp1 sp2 p (TyCon a b c) = showsThree sp1 sp2 "TyCon" p a b c instance (Ord a, Show a, Show b) => Show1 (TyFamily a b) where showsPrecWith = showsPrecWith2 showsPrec instance (Ord a, Show a) => Show2 (TyFamily a) where showsPrecWith2 sp1 sp2 p (TyFamily a b c) = showsThree sp1 sp2 "TyFamily" p a b c showsThree :: Show a => (Int -> b -> ShowS) -> (Int -> c -> ShowS) -> String -> Int -> a -> b -> c -> ShowS showsThree sp1 sp2 name p a b c = showParen (p > appPrec) $ showString name . showSpace . showsPrec appPrec1 a . showSpace . sp1 appPrec1 b . showSpace . sp2 appPrec1 c ------------------------------------------------------------------------------- $(return []) instance (Ord a, TextShow a, TextShow b, TextShow c) => TextShow (TyCon a b c) where showbPrec = $(makeShowbPrec ''TyCon) instance (Ord a, TextShow a, TextShow b) => TextShow1 (TyCon a b) where showbPrecWith = $(makeShowbPrecWith ''TyCon) instance (Ord a, TextShow a) => TextShow2 (TyCon a) where showbPrecWith2 = $(makeShowbPrecWith2 ''TyCon) #if MIN_VERSION_template_haskell(2,7,0) instance (Ord a, TextShow a, TextShow b, TextShow c) => TextShow (TyFamily a b c) where showbPrec = $(makeShowbPrec 'TyFamily) instance (Ord a, TextShow a, TextShow b) => TextShow1 (TyFamily a b) where showbPrecWith = $(makeShowbPrecWith 'TyFamily) instance (Ord a, TextShow a) => TextShow2 (TyFamily a) where showbPrecWith2 = $(makeShowbPrecWith2 'TyFamily) #endif text-show-2.1.1/tests/Derived/TypeSynonyms.hs0000644000000000000000000000730712575552406017446 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #endif {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Derived.TypeSynonyms Copyright: (C) 2014-2015 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 __GLASGOW_HASKELL__ >= 702 import GHC.Generics (Generic) # if defined(__LANGUAGE_DERIVE_GENERIC1__) import GHC.Generics (Generic1) # endif #else import qualified Generics.Deriving.TH as Generics (deriveAll) #endif import Prelude import Test.QuickCheck (Arbitrary) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) import TransformersCompat (Show1(..), Show2(..), showsUnaryWith) ------------------------------------------------------------------------------- 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) instance (Show a, Show b) => Show2 ((,,,) a b) where showsPrecWith2 sp1 sp2 _ (a, b, c, d) = showChar '(' . showsPrec 0 a . showChar ',' . showsPrec 0 b . showChar ',' . sp1 0 c . showChar ',' . sp2 0 d . showChar ')' ------------------------------------------------------------------------------- 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 defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #endif ) ------------------------------------------------------------------------------- data family TyFamily #if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710 a b :: * #else y z :: * #endif 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 ) ------------------------------------------------------------------------------- instance Show a => Show1 (TyCon a) where showsPrecWith = showsPrecWith2 showsPrec instance Show2 TyCon where showsPrecWith2 sp1 sp2 p (TyCon x) = showsUnaryWith (showsPrecWith2 (showsPrecWith2 showsPrec sp1) (showsPrecWith2 sp1 sp2) ) "TyCon" p x instance Show a => Show1 (TyFamily a) where showsPrecWith = showsPrecWith2 showsPrec instance Show2 TyFamily where showsPrecWith2 sp1 sp2 p (TyFamily x) = showsUnaryWith (showsPrecWith2 (showsPrecWith2 showsPrec sp1) (showsPrecWith2 sp1 sp2) ) "TyFamily" p x ------------------------------------------------------------------------------- $(deriveTextShow ''TyCon) $(deriveTextShow1 ''TyCon) $(deriveTextShow2 ''TyCon) #if MIN_VERSION_template_haskell(2,7,0) $(deriveTextShow 'TyFamily) $(deriveTextShow1 'TyFamily) $(deriveTextShow2 'TyFamily) #endif #if __GLASGOW_HASKELL__ < 702 $(Generics.deriveAll ''TyCon) #endif text-show-2.1.1/tests/Spec/0000755000000000000000000000000012575552406013712 5ustar0000000000000000text-show-2.1.1/tests/Spec/GenericSpec.hs0000644000000000000000000000132212575552406016433 0ustar0000000000000000{-| Module: Spec.GenericSpec Copyright: (C) 2014-2015 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 Instances.Generic () import Spec.Utils (prop_matchesTextShow, prop_genericTextShow) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) import TextShow.Generic (ConType) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "ConType" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> ConType -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> ConType -> Bool) text-show-2.1.1/tests/Spec/FromStringTextShowSpec.hs0000644000000000000000000000560012575552406020662 0ustar0000000000000000{-| Module: Spec.FromStringTextShowSpec Copyright: (C) 2014-2015 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 Instances.FromStringTextShow () import Spec.Utils (prop_matchesTextShow, prop_matchesTextShow1, prop_matchesTextShow2) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) import TextShow (FromStringShow(..), FromTextShow(..)) import TransformersCompat (FromStringShow1(..), FromStringShow2(..), FromTextShow1(..), FromTextShow2(..)) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "FromStringShow Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> FromStringShow Int -> Bool) prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> FromStringShow Int -> Bool) describe "FromStringShow String" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> FromStringShow String -> Bool) prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> FromStringShow String -> Bool) describe "FromTextShow Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> FromTextShow Int -> Bool) prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> FromTextShow Int -> Bool) describe "FromTextShow String" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> FromTextShow String -> Bool) prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> FromTextShow String -> Bool) describe "FromStringShow1 Maybe Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> FromStringShow1 Maybe Int -> Bool) prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> FromStringShow1 Maybe Int -> Bool) describe "FromTextShow1 Maybe Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> FromTextShow1 Maybe Int -> Bool) prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> FromTextShow1 Maybe Int -> Bool) describe "FromStringShow2 Either Char Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> FromStringShow2 Either Char Int -> Bool) prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> FromStringShow2 Either Char Int -> Bool) prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> FromStringShow2 Either Char Int -> Bool) describe "FromTextShow2 Either Char Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> FromTextShow2 Either Char Int -> Bool) prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> FromTextShow2 Either Char Int -> Bool) prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> FromTextShow2 Either Char Int -> Bool) text-show-2.1.1/tests/Spec/Utils.hs0000644000000000000000000001005112575552406015343 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-| Module: Spec.Utils Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Testing-related utility functions. -} module Spec.Utils ( ioProperty , prop_matchesTextShow , prop_matchesTextShow1 , prop_matchesTextShow2 , prop_genericTextShow , prop_genericTextShow' , prop_genericTextShow1 ) where #include "generic.h" #if __GLASGOW_HASKELL__ >= 702 import GHC.Generics (Generic, Rep) # if defined(__LANGUAGE_DERIVE_GENERIC1__) import GHC.Generics (Generic1, Rep1) # endif import TextShow.Generic #endif #if MIN_VERSION_QuickCheck(2,7,0) import qualified Test.QuickCheck as QC (ioProperty) #else import Test.QuickCheck (morallyDubiousIOProperty) #endif import Test.QuickCheck (Property, Testable) import TextShow (TextShow(..), TextShow1(..), TextShow2(..), Builder, FromStringShow(..)) import TransformersCompat (Show1, Show2, FromStringShow1(..), FromStringShow2(..)) ioProperty :: Testable prop => IO prop -> Property #if MIN_VERSION_QuickCheck(2,7,0) ioProperty = QC.ioProperty #else ioProperty = morallyDubiousIOProperty #endif -- | Verifies that a type's @Show@ instances coincide for both 'String's and 'Text', -- irrespective of precedence. prop_matchesTextShow :: (Show a, TextShow a) => Int -> a -> Bool prop_matchesTextShow p x = showbPrec p (FromStringShow x) == showbPrec p x -- | Verifies that a type's @Show1@ instances coincide for both 'String's and 'Text', -- irrespective of precedence. prop_matchesTextShow1 :: (Show1 f, TextShow1 f) => Int -> f a -> Bool prop_matchesTextShow1 p x = showbPrecWith showb27Prec p (FromStringShow1 x) == showbPrecWith showb27Prec p x -- | Verifies that a type's @Show2@ instances coincide for both 'String's and 'Text', -- irrespective of precedence. prop_matchesTextShow2 :: (Show2 f, TextShow2 f) => Int -> f a b -> Bool prop_matchesTextShow2 p x = showbPrecWith2 showb27Prec showb42Prec p (FromStringShow2 x) == showbPrecWith2 showb27Prec showb42Prec p x -- | Show the number 27, which certain parody singer-songwriters find humorous. -- Useful for testing higher-order @Show@ classes. showb27Prec :: Int -> a -> Builder showb27Prec p _ = showbPrec p $ Just (27 :: Int) -- | Show the number 42, which is said to be the answer to something or other. -- Useful for testing higher-order @Show@ classes. showb42Prec :: Int -> a -> Builder showb42Prec p _ = showbPrec p $ Just (42 :: Int) -- | Verifies that a type's 'TextShow' instance coincides with the output produced -- by the equivalent 'Generic' functions. #if __GLASGOW_HASKELL__ >= 702 prop_genericTextShow :: (TextShow a, Generic a, GTextShow (Rep a)) => Int -> a -> Bool prop_genericTextShow p x = showbPrec p x == genericShowbPrec p x #else prop_genericTextShow :: Int -> a -> Bool prop_genericTextShow _ _ = True #endif -- | Behaves exactly like 'prop_genericTextShow', except only for GHC 7.6 and above. -- This is useful with type families, which couldn't properly have derived 'Generic' -- instances until GHC 7.6 due to a bug. #if __GLASGOW_HASKELL__ >= 706 prop_genericTextShow' :: (TextShow a, Generic a, GTextShow (Rep a)) => Int -> a -> Bool prop_genericTextShow' = prop_genericTextShow #else prop_genericTextShow' :: Int -> f a -> Bool prop_genericTextShow' _ _ = True #endif -- | Verifies that a type's 'TextShow1' instance coincides with the output produced -- by the equivalent 'Generic1' functions. #if defined(__LANGUAGE_DERIVE_GENERIC1__) prop_genericTextShow1 :: (TextShow1 f, Generic1 f, GTextShow1 (Rep1 f)) => Int -> f a -> Bool prop_genericTextShow1 p x = showbPrecWith showb27Prec p x == genericShowbPrecWith showb27Prec p x #else prop_genericTextShow1 :: Int -> f a -> Bool prop_genericTextShow1 _ _ = True #endif text-show-2.1.1/tests/Spec/FunctionsSpec.hs0000644000000000000000000000122512575552406017031 0ustar0000000000000000{-| Module: Spec.FunctionsSpec Copyright: (C) 2014-2015 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 Spec.Utils (prop_matchesTextShow) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) import Text.Show.Functions () import TextShow.Functions () main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Int -> Int" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> (Int -> Int) -> Bool) text-show-2.1.1/tests/Spec/BuilderSpec.hs0000644000000000000000000000336112575552406016452 0ustar0000000000000000{-| Module: Spec.BuilderSpec Copyright: (C) 2014-2015 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-2.1.1/tests/Spec/Data/0000755000000000000000000000000012575552406014563 5ustar0000000000000000text-show-2.1.1/tests/Spec/Data/BoolSpec.hs0000644000000000000000000000124012575552406016622 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Data.BoolSpec Copyright: (C) 2014-2015 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 Spec.Utils (prop_matchesTextShow, prop_genericTextShow) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Bool" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> Bool -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> Bool -> Bool) text-show-2.1.1/tests/Spec/Data/ArraySpec.hs0000644000000000000000000000210612575552406017007 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Data.ArraySpec Copyright: (C) 2014-2015 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 Spec.Utils (prop_matchesTextShow) import Test.Hspec (describe) import Test.Hspec.QuickCheck (prop) #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" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Array Int Int -> Bool) describe "UArray Int Int" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> UArray Int Int -> Bool) #else pure () #endif text-show-2.1.1/tests/Spec/Data/ByteStringSpec.hs0000644000000000000000000000221612575552406020025 0ustar0000000000000000{-| Module: Spec.Data.ByteStringSpec Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the @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 Instances.Data.ByteString () import Spec.Utils (prop_matchesTextShow) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) import Test.QuickCheck.Instances () main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "strict ByteString" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> BS.ByteString -> Bool) describe "lazy ByteString" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> BL.ByteString -> Bool) describe "ShortByteString" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> ShortByteString -> Bool) text-show-2.1.1/tests/Spec/Data/ListSpec.hs0000644000000000000000000000235312575552406016650 0ustar0000000000000000{-| Module: Spec.Data.ListSpec Copyright: (C) 2014-2015 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 Spec.Utils (prop_matchesTextShow) 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" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> String -> Bool) describe "[String]" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> [String] -> Bool) describe "[Int]" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> [Int] -> Bool) 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-2.1.1/tests/Spec/Data/OrdSpec.hs0000644000000000000000000000164212575552406016461 0ustar0000000000000000{-| Module: Spec.Data.OrdSpec Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "Data.Ord" module. -} module Spec.Data.OrdSpec (main, spec) where import Data.Orphans () import Generics.Deriving.Instances () import GHC.Exts (Down) import Instances.Data.Ord () import Spec.Utils (prop_matchesTextShow, prop_genericTextShow) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "Ordering" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> Ordering -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> Ordering -> Bool) describe "Down Int" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Down Int -> Bool) text-show-2.1.1/tests/Spec/Data/VersionSpec.hs0000644000000000000000000000147412575552406017365 0ustar0000000000000000module Spec.Data.VersionSpec (main, spec) where import Data.Version (Version, showVersion) import Instances.Data.Version () import Spec.Utils (prop_matchesTextShow) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) import TextShow (fromString) import TextShow.Data.Version (showbVersionConcrete) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "Version" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Version -> Bool) describe "showbVersionConcrete" $ 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) == showbVersionConcrete v text-show-2.1.1/tests/Spec/Data/FixedSpec.hs0000644000000000000000000000336312575552406016776 0ustar0000000000000000{-| Module: Spec.Data.FixedSpec Copyright: (C) 2014-2015 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 Spec.Utils (prop_matchesTextShow) 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" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Fixed E0 -> Bool) describe "Fixed E1" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Fixed E1 -> Bool) describe "Fixed E2" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Fixed E2 -> Bool) describe "Fixed E3" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Fixed E3 -> Bool) describe "Fixed E6" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Fixed E6 -> Bool) describe "Fixed E9" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Fixed E9 -> Bool) describe "Fixed E12" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Fixed E12 -> Bool) 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-2.1.1/tests/Spec/Data/TupleSpec.hs0000644000000000000000000001136612575552406017032 0ustar0000000000000000{-| Module: Spec.Data.TupleSpec Copyright: (C) 2014-2015 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 Generics.Deriving.Instances () import Instances.Data.Tuple () import Spec.Utils (prop_matchesTextShow, prop_matchesTextShow2, prop_genericTextShow, prop_genericTextShow1) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "()" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> () -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> () -> Bool) describe "(Int, Int)" $ do prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> (Int, Int) -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> (Int, Int) -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> (Int, Int) -> Bool) describe "(Int, Int, Int)" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> (Int, Int, Int) -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> (Int, Int, Int) -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> (Int, Int, Int) -> Bool) describe "(Int, Int, Int, Int)" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> (Int, Int, Int, Int) -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> (Int, Int, Int, Int) -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> (Int, Int, Int, Int) -> Bool) describe "(Int, Int, Int, Int, Int)" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> (Int, Int, Int, Int, Int) -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> (Int, Int, Int, Int, Int) -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> (Int, Int, Int, Int, Int) -> Bool) describe "(Int, Int, Int, Int, Int, Int)" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> (Int, Int, Int, Int, Int, Int) -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> (Int, Int, Int, Int, Int, Int) -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> (Int, Int, Int, Int, Int, Int) -> Bool) describe "(Int, Int, Int, Int, Int, Int, Int)" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> (Int, Int, Int, Int, Int, Int, Int) -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> (Int, Int, Int, Int, Int, Int, Int) -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> (Int, Int, Int, Int, Int, Int, Int) -> Bool) describe "(Int, Int, Int, Int, Int, Int, Int, Int)" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> (Int, Int, Int, Int, Int, Int, Int, Int) -> Bool) describe "(Int, Int, Int, Int, Int, Int, Int, Int, Int)" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> (Int, Int, Int, Int, Int, Int, Int, Int, Int) -> Bool) describe "(Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int) -> Bool) describe "(Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int) -> Bool) describe "(Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int) -> Bool) describe "(Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int) -> Bool) describe "(Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int) -> Bool) describe "(Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int) -> Bool) text-show-2.1.1/tests/Spec/Data/CharSpec.hs0000644000000000000000000000201212575552406016602 0ustar0000000000000000{-| Module: Spec.Data.CharSpec Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "Data.Char" module. -} module Spec.Data.CharSpec (main, spec) where import Data.Array (elems) import Data.Char (GeneralCategory) import GHC.Show (asciiTab) import Instances.Data.Char () import Spec.Utils (prop_matchesTextShow) import Test.Hspec (Spec, describe, hspec, it, parallel, shouldBe) import Test.Hspec.QuickCheck (prop) import TextShow (fromString) import TextShow.Data.Char (asciiTabB) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "Char" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Char -> Bool) describe "GeneralCategory" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> GeneralCategory -> Bool) describe "asciiTabB" $ it "equals asciiTab" $ map fromString asciiTab `shouldBe` elems asciiTabB text-show-2.1.1/tests/Spec/Data/DataSpec.hs0000644000000000000000000000214312575552406016603 0ustar0000000000000000{-| Module: Spec.Data.DataSpec Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "Data.Data" module. -} module Spec.Data.DataSpec (main, spec) where import Data.Data (Constr, ConstrRep, DataRep, DataType, Fixity) import Instances.Data.Data () import Spec.Utils (prop_matchesTextShow) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "Constr" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Constr -> Bool) describe "ConstrRep" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> ConstrRep -> Bool) describe "DataRep" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> DataRep -> Bool) describe "DataType" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> DataType -> Bool) describe "Fixity" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Fixity -> Bool) text-show-2.1.1/tests/Spec/Data/DynamicSpec.hs0000644000000000000000000000116512575552406017321 0ustar0000000000000000{-| Module: Spec.Data.DynamicSpec Copyright: (C) 2014-2015 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 Instances.Data.Dynamic () import Spec.Utils (prop_matchesTextShow) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Dynamic" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Dynamic -> Bool) text-show-2.1.1/tests/Spec/Data/ProxySpec.hs0000644000000000000000000000132712575552406017056 0ustar0000000000000000{-| Module: Spec.Data.ProxySpec Copyright: (C) 2014-2015 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 Instances.Data.Proxy () import Spec.Utils (prop_matchesTextShow, prop_genericTextShow) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Proxy Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> Proxy Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> Proxy Int -> Bool) text-show-2.1.1/tests/Spec/Data/MonoidSpec.hs0000644000000000000000000000532412575552406017163 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Data.MonoidSpec Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "Data.Monoid" module. -} module Spec.Data.MonoidSpec (main, spec) where import Data.Monoid import Generics.Deriving.Instances () import Instances.Data.Monoid () import Spec.Utils (prop_matchesTextShow, prop_genericTextShow, prop_genericTextShow1) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "All" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> All -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> All -> Bool) describe "Any" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> Any -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> Any -> Bool) describe "Dual Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> Dual Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> Dual Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> Dual Int -> Bool) describe "First Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> First Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> First Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> First Int -> Bool) describe "Last Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> Last Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> Last Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> Last Int -> Bool) describe "Product Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> Product Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> Product Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> Product Int -> Bool) describe "Sum Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> Sum Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> Sum Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> Sum Int -> Bool) #if MIN_VERSION_base(4,8,0) describe "Alt Maybe Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> Alt Maybe Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> Alt Maybe Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> Alt Maybe Int -> Bool) #endif text-show-2.1.1/tests/Spec/Data/TypeableSpec.hs0000644000000000000000000000142212575552406017476 0ustar0000000000000000{-| Module: Spec.Data.TypeableSpec Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "Data.Typeable" module. -} module Spec.Data.TypeableSpec (main, spec) where import Data.Typeable (TyCon, TypeRep) import Instances.Data.Typeable () import Spec.Utils (prop_matchesTextShow) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "TypeRep" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> TypeRep -> Bool) describe "TyCon" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> TyCon -> Bool) text-show-2.1.1/tests/Spec/Data/TextSpec.hs0000644000000000000000000000341112575552406016655 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Data.TextSpec Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the @text@ library. -} module Spec.Data.TextSpec (main, spec) where import Instances.Data.Text () import Spec.Utils (prop_matchesTextShow) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) 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" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Builder -> Bool) describe "strict Text" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> TS.Text -> Bool) describe "lazy Text" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> TL.Text -> Bool) describe "I16" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> I16 -> Bool) describe "UnicodeException" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> UnicodeException -> Bool) #if MIN_VERSION_text(1,0,0) describe "Decoding" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Decoding -> Bool) #endif #if MIN_VERSION_text(1,1,0) describe "Size" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Size -> Bool) #endif text-show-2.1.1/tests/Spec/Data/IntegralSpec.hs0000644000000000000000000000560612575552406017506 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Data.IntegralSpec Copyright: (C) 2014-2015 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.Word (Word8, Word16, Word32, Word64) import Prelude () import Prelude.Compat import Spec.Utils (prop_matchesTextShow) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) #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 TextShow (fromString) import TextShow.Data.Integral (showbIntAtBase) #endif main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "Int" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Int -> Bool) describe "Int8" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Int8 -> Bool) describe "Int16" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Int16 -> Bool) describe "Int32" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Int32 -> Bool) describe "Int64" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Int64 -> Bool) describe "Integer" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Integer -> Bool) describe "Word" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Word -> Bool) describe "Word8" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Word8 -> Bool) describe "Word16" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Word16 -> Bool) describe "Word32" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Word32 -> Bool) describe "Word64" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Word64 -> Bool) #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-2.1.1/tests/Spec/Data/ComplexSpec.hs0000644000000000000000000000114112575552406017336 0ustar0000000000000000{-| Module: Spec.Data.ComplexSpec Copyright: (C) 2014-2015 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 Spec.Utils (prop_matchesTextShow) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Complex Double" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Complex Double -> Bool) text-show-2.1.1/tests/Spec/Data/MaybeSpec.hs0000644000000000000000000000144212575552406016770 0ustar0000000000000000{-| Module: Spec.Data.MaybeSpec Copyright: (C) 2014-2015 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 Spec.Utils (prop_matchesTextShow1, prop_genericTextShow, prop_genericTextShow1) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Maybe Int" $ do prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> Maybe Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> Maybe Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> Maybe Int -> Bool) text-show-2.1.1/tests/Spec/Data/EitherSpec.hs0000644000000000000000000000151012575552406017147 0ustar0000000000000000{-| Module: Spec.Data.EitherSpec Copyright: (C) 2014-2015 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 Generics.Deriving.Instances () import Spec.Utils (prop_matchesTextShow2, prop_genericTextShow, prop_genericTextShow1) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Either Int Int" $ do prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> Either Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> Either Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> Either Int Int -> Bool) text-show-2.1.1/tests/Spec/Data/RatioSpec.hs0000644000000000000000000000112012575552406017002 0ustar0000000000000000{-| Module: Spec.Data.RatioSpec Copyright: (C) 2014-2015 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.Ratio (Ratio) import Spec.Utils (prop_matchesTextShow) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Ratio Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> Ratio Int -> Bool) text-show-2.1.1/tests/Spec/Data/FloatingSpec.hs0000644000000000000000000000450612575552406017502 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Data.FloatingSpec Copyright: (C) 2014-2015 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.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 (prop_matchesTextShow) 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" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Float -> Bool) describe "Double" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Double -> Bool) 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" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> FPFormat -> Bool) -- | 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-2.1.1/tests/Spec/Data/OldTypeableSpec.hs0000644000000000000000000000217112575552406020137 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-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "Data.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 Spec.Utils (prop_matchesTextShow) import Test.Hspec (describe) import Test.Hspec.QuickCheck (prop) #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" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> TypeRep -> Bool) describe "TyCon" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> TyCon -> Bool) #else pure () #endif text-show-2.1.1/tests/Spec/Data/Functor/0000755000000000000000000000000012575552406016203 5ustar0000000000000000text-show-2.1.1/tests/Spec/Data/Functor/IdentitySpec.hs0000644000000000000000000000130312575552406021140 0ustar0000000000000000{-| Module: Spec.Data.Functor.Identity Copyright: (C) 2014-2015 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 Data.Functor.Classes () import Data.Functor.Identity (Identity) import Instances.Data.Functor.Identity () import Spec.Utils (prop_matchesTextShow1) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Identity Int" $ prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> Identity Int -> Bool) text-show-2.1.1/tests/Spec/Data/Type/0000755000000000000000000000000012575552406015504 5ustar0000000000000000text-show-2.1.1/tests/Spec/Data/Type/EqualitySpec.hs0000644000000000000000000000155512575552406020456 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TypeOperators #-} {-| Module: Spec.Data.Type.EqualitySpec Copyright: (C) 2014-2015 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.Type.Equality ((:~:)) import Spec.Utils (prop_matchesTextShow) import Test.Hspec (describe) import Test.Hspec.QuickCheck (prop) #endif main :: IO () main = hspec spec spec :: Spec spec = parallel $ #if MIN_VERSION_base(4,7,0) describe "Int :~: Int" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Int :~: Int -> Bool) #else pure () #endif text-show-2.1.1/tests/Spec/Data/Type/CoercionSpec.hs0000644000000000000000000000156312575552406020421 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Data.Type.CoercionSpec Copyright: (C) 2014-2015 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.Type.Coercion (Coercion) import Spec.Utils (prop_matchesTextShow) import Test.Hspec (describe) import Test.Hspec.QuickCheck (prop) #endif main :: IO () main = hspec spec spec :: Spec spec = parallel $ #if MIN_VERSION_base(4,7,0) describe "Coercion All Bool" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Coercion All Bool -> Bool) #else pure () #endif text-show-2.1.1/tests/Spec/System/0000755000000000000000000000000012575552406015176 5ustar0000000000000000text-show-2.1.1/tests/Spec/System/ExitSpec.hs0000644000000000000000000000116512575552406017261 0ustar0000000000000000{-| Module: Spec.System.ExitSpec Copyright: (C) 2014-2015 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 Instances.System.Exit () import Spec.Utils (prop_matchesTextShow) import System.Exit (ExitCode) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "ExitCode" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> ExitCode -> Bool) text-show-2.1.1/tests/Spec/System/IOSpec.hs0000644000000000000000000000510412575552406016654 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.System.IOSpec Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "System.IO" module. -} module Spec.System.IOSpec (main, spec) where #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 (ioProperty, 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, oneof) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "Handle" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Handle -> Bool) describe "IOMode" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> IOMode -> Bool) describe "BufferMode" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> BufferMode -> Bool) describe "HandlePosn" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> HandlePosn -> Bool) describe "SeekMode" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> SeekMode -> Bool) describe "TextEncoding" $ prop "TextShow instance" prop_showTextEncoding #if MIN_VERSION_base(4,4,0) describe "CodingProgress" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CodingProgress -> Bool) describe "CodingFailureMode" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CodingFailureMode -> Bool) #endif describe "Newline" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Newline -> Bool) describe "NewlineMode" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> NewlineMode -> Bool) -- | 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-2.1.1/tests/Spec/System/Posix/0000755000000000000000000000000012575552406016300 5ustar0000000000000000text-show-2.1.1/tests/Spec/System/Posix/TypesSpec.hs0000644000000000000000000000467112575552406020563 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.System.Posix.TypesSpec Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "System.Posix.Types" module. -} module Spec.System.Posix.TypesSpec (main, spec) where import Instances.System.Posix.Types () import Spec.Utils (prop_matchesTextShow) import System.Posix.Types import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) #include "HsBaseConfig.h" main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "Fd" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Fd -> Bool) #if defined(HTYPE_DEV_T) describe "CDev" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CDev -> Bool) #endif #if defined(HTYPE_INO_T) describe "CIno" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CIno -> Bool) #endif #if defined(HTYPE_MODE_T) describe "CMode" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CMode -> Bool) #endif #if defined(HTYPE_OFF_T) describe "COff" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> COff -> Bool) #endif #if defined(HTYPE_PID_T) describe "CPid" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CPid -> Bool) #endif #if defined(HTYPE_SSIZE_T) describe "CSsize" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CSsize -> Bool) #endif #if defined(HTYPE_GID_T) describe "CGid" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CGid -> Bool) #endif #if defined(HTYPE_NLINK_T) describe "CNlink" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CNlink -> Bool) #endif #if defined(HTYPE_UID_T) describe "CUid" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CUid -> Bool) #endif #if defined(HTYPE_CC_T) describe "CCc" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CCc -> Bool) #endif #if defined(HTYPE_SPEED_T) describe "CSpeed" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CSpeed -> Bool) #endif #if defined(HTYPE_TCFLAG_T) describe "CTcflag" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CTcflag -> Bool) #endif #if defined(HTYPE_RLIM_T) describe "CRLim" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CRLim -> Bool) #endif text-show-2.1.1/tests/Spec/Derived/0000755000000000000000000000000012575552406015274 5ustar0000000000000000text-show-2.1.1/tests/Spec/Derived/RecordsSpec.hs0000644000000000000000000000247712575552406020056 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Derived.RecordsSpec Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types with record syntax. -} module Spec.Derived.RecordsSpec (main, spec) where import Derived.Records import Spec.Utils (prop_matchesTextShow2, prop_genericTextShow, prop_genericTextShow1) #if MIN_VERSION_template_haskell(2,7,0) import Spec.Utils (prop_genericTextShow') #endif import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "TyCon Int Int" $ do prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyCon Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> TyCon Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyCon Int Int -> Bool) #if MIN_VERSION_template_haskell(2,7,0) describe "TyFamily Int Int" $ do prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyFamily Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow' :: Int -> TyFamily Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyFamily Int Int -> Bool) #endif text-show-2.1.1/tests/Spec/Derived/ExistentialQuantificationSpec.hs0000644000000000000000000000164112575552406023635 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Derived.ExistentialQuantificationSpec Copyright: (C) 2014-2015 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 Derived.ExistentialQuantification import Spec.Utils (prop_matchesTextShow2) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "TyCon Int Int Int Int" $ prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyCon Int Int Int Int -> Bool) #if MIN_VERSION_template_haskell(2,7,0) describe "TyFamily Int Int Int Int" $ prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyFamily Int Int Int Int -> Bool) #endif text-show-2.1.1/tests/Spec/Derived/DatatypeContextsSpec.hs0000644000000000000000000000157112575552406021752 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Derived.DatatypeContextsSpec Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types with DatatypeContexts (eww). -} module Spec.Derived.DatatypeContextsSpec (main, spec) where import Derived.DatatypeContexts import Spec.Utils (prop_matchesTextShow2) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "TyCon Int Int Int" $ prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyCon Int Int Int -> Bool) #if MIN_VERSION_template_haskell(2,7,0) describe "TyFamily Int Int Int" $ prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyFamily Int Int Int -> Bool) #endif text-show-2.1.1/tests/Spec/Derived/TypeSynonymsSpec.hs0000644000000000000000000000251312575552406021145 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Derived.TypeSynonymsSpec Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types that use type synonyms. -} module Spec.Derived.TypeSynonymsSpec (main, spec) where import Derived.TypeSynonyms import Spec.Utils (prop_matchesTextShow, prop_genericTextShow, prop_genericTextShow1) #if MIN_VERSION_template_haskell(2,7,0) import Spec.Utils (prop_genericTextShow') #endif import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "TyCon Int Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> TyCon Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> TyCon Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyCon Int Int -> Bool) #if MIN_VERSION_template_haskell(2,7,0) describe "TyFamily Int Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> TyFamily Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow' :: Int -> TyFamily Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyFamily Int Int -> Bool) #endif text-show-2.1.1/tests/Spec/Derived/RankNTypesSpec.hs0000644000000000000000000000151312575552406020501 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Derived.RankNTypesSpec Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types with rank-n voodoo. -} module Spec.Derived.RankNTypesSpec (main, spec) where import Derived.Records import Spec.Utils (prop_matchesTextShow2) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "TyCon Int Int" $ prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyCon Int Int -> Bool) #if MIN_VERSION_template_haskell(2,7,0) describe "TyFamily Int Int" $ prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyFamily Int Int -> Bool) #endif text-show-2.1.1/tests/Spec/Derived/DataFamiliesSpec.hs0000644000000000000000000000276312575552406020776 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Derived.DataFamiliesSpec Copyright: (C) 2014-2015 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 Derived.DataFamilies (NotAllShow) import Spec.Utils (prop_matchesTextShow2, prop_genericTextShow', prop_genericTextShow1) import Test.Hspec (describe) import Test.Hspec.QuickCheck (prop) # if __GLASGOW_HASKELL__ >= 708 import Derived.DataFamilies (NullaryData) import Spec.Utils (prop_matchesTextShow) # 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 prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> NotAllShow Int Int Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow' :: Int -> NotAllShow Int Int Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> NotAllShow Int Int Int Int -> Bool) # if __GLASGOW_HASKELL__ >= 708 describe "NullaryData" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> NullaryData -> Bool) prop "generic TextShow" (prop_genericTextShow' :: Int -> NullaryData -> Bool) # endif #else pure () #endif text-show-2.1.1/tests/Spec/Derived/MagicHashSpec.hs0000644000000000000000000000153512575552406020273 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-| Module: Spec.Derived.MagicHashSpec Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types with fields that have unlifted types. -} module Spec.Derived.MagicHashSpec (main, spec) where import Derived.MagicHash import Spec.Utils (prop_matchesTextShow) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "TyCon#" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> TyCon# -> Bool) #if MIN_VERSION_template_haskell(2,7,0) describe "TyFamily#" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> TyFamily# -> Bool) #endif text-show-2.1.1/tests/Spec/Derived/PolyKindsSpec.hs0000644000000000000000000000624212575552406020363 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Derived.PolyKindsSpec Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types with poly-kinded type variables. -} module Spec.Derived.PolyKindsSpec (main, spec) where import Derived.PolyKinds import Spec.Utils (prop_matchesTextShow2, prop_genericTextShow, prop_genericTextShow1) #if MIN_VERSION_template_haskell(2,7,0) import Spec.Utils (prop_genericTextShow') #endif import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "TyConCompose Either Either Either Maybe Maybe Int Int" $ do prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyConCompose Either Either Either Maybe Maybe Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> TyConCompose Either Either Either Maybe Maybe Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyConCompose Either Either Either Maybe Maybe Int Int -> Bool) describe "TyConProxy Int Int" $ do prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyConProxy Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> TyConProxy Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyConProxy Int Int -> Bool) describe "TyConReallyHighKinds (,,,,) Int Int Int Int Int" $ do prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyConReallyHighKinds (,,,,) Int Int Int Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> TyConReallyHighKinds (,,,,) Int Int Int Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyConReallyHighKinds (,,,,) Int Int Int Int Int -> Bool) #if MIN_VERSION_template_haskell(2,7,0) describe "TyFamilyCompose Either Either Either Maybe Maybe Int Int" $ do prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyFamilyCompose Either Either Either Maybe Maybe Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow' :: Int -> TyFamilyCompose Either Either Either Maybe Maybe Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyFamilyCompose Either Either Either Maybe Maybe Int Int -> Bool) describe "TyFamilyProxy Int Int" $ do prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyFamilyProxy Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow' :: Int -> TyFamilyProxy Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyFamilyProxy Int Int -> Bool) describe "TyFamilyReallyHighKinds (,,,,) Int Int Int Int Int" $ do prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> TyFamilyReallyHighKinds (,,,,) Int Int Int Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow' :: Int -> TyFamilyReallyHighKinds (,,,,) Int Int Int Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyFamilyReallyHighKinds (,,,,) Int Int Int Int Int -> Bool) #endif text-show-2.1.1/tests/Spec/Derived/InfixSpec.hs0000644000000000000000000000366612575552406017533 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Derived.InfixSpec Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types with infix constructors. -} module Spec.Derived.InfixSpec (main, spec) where import Derived.Infix import Spec.Utils (prop_matchesTextShow, prop_genericTextShow, prop_genericTextShow', prop_genericTextShow1) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "TyConPlain Int Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> TyConPlain Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> TyConPlain Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyConPlain Int Int -> Bool) describe "TyConGADT Int Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> TyConGADT Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow' :: Int -> TyConGADT Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyConGADT Int Int -> Bool) #if MIN_VERSION_template_haskell(2,7,0) describe "TyFamilyPlain Int Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> TyFamilyPlain Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow' :: Int -> TyFamilyPlain Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyFamilyPlain Int Int -> Bool) describe "TyFamilyGADT Int Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> TyFamilyGADT Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow' :: Int -> TyFamilyGADT Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyFamilyGADT Int Int -> Bool) #endif text-show-2.1.1/tests/Spec/GHC/0000755000000000000000000000000012575552406014313 5ustar0000000000000000text-show-2.1.1/tests/Spec/GHC/StaticPtrSpec.hs0000644000000000000000000000150012575552406017373 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.GHC.StaticPtrSpec Copyright: (C) 2014-2015 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 GHC.StaticPtr (StaticPtrInfo) import Spec.Utils (prop_matchesTextShow) import Test.Hspec (describe) import Test.Hspec.QuickCheck (prop) #endif main :: IO () main = hspec spec spec :: Spec spec = parallel $ #if MIN_VERSION_base(4,8,0) describe "StaticPtrInfo" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> StaticPtrInfo -> Bool) #else pure () #endif text-show-2.1.1/tests/Spec/GHC/TypeLitsSpec.hs0000644000000000000000000000345312575552406017244 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-2015 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 GHC.TypeLits import Spec.Utils (prop_matchesTextShow) import Test.Hspec (describe) import Test.Hspec.QuickCheck (prop) #endif main :: IO () main = hspec spec spec :: Spec spec = parallel $ do #if MIN_VERSION_base(4,7,0) describe "SomeNat" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> SomeNat -> Bool) describe "SomeSymbol" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> SomeSymbol -> Bool) #elif MIN_VERSION_base(4,6,0) describe "IsEven 0" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> IsEven 0 -> Bool) describe "IsEven 1" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> IsEven 1 -> Bool) describe "IsEven 2" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> IsEven 2 -> Bool) describe "IsZero 0" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> IsZero 0 -> Bool) describe "IsZero 1" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> IsZero 1 -> Bool) describe "Sing 0" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Sing 0 -> Bool) describe "Sing \"a\"" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Sing "a" -> Bool) #else pure () #endif text-show-2.1.1/tests/Spec/GHC/EventSpec.hs0000644000000000000000000000233512575552406016546 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.GHC.EventSpec Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "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 GHC.Event (Event) # if MIN_VERSION_base(4,8,1) import GHC.Event (Lifetime) #endif import Spec.Utils (prop_matchesTextShow) import Test.Hspec (describe) import Test.Hspec.QuickCheck (prop) #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" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Event -> Bool) -- describe "FdKey" $ -- prop "TextShow instance" (prop_matchesTextShow :: Int -> FdKey -> Bool) # if MIN_VERSION_base(4,8,1) describe "Lifetime" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Lifetime -> Bool) # endif #else pure () #endif text-show-2.1.1/tests/Spec/GHC/GenericsSpec.hs0000644000000000000000000000607012575552406017224 0ustar0000000000000000{-# LANGUAGE TypeOperators #-} {-| Module: Spec.GHC.GenericsSpec Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "GHC.Generics" module. -} module Spec.GHC.GenericsSpec (main, spec) where import Data.Orphans () import Generics.Deriving.Base (U1, Par1, Rec1, K1, M1, (:+:), (:*:), (:.:), Fixity, Associativity, Arity) import Generics.Deriving.Instances () import Instances.GHC.Generics () import Spec.Utils (prop_matchesTextShow, prop_genericTextShow) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "Fixity" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> Fixity -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> Fixity -> Bool) describe "Associativity" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> Associativity -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> Associativity -> Bool) describe "Arity" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> Arity -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> Arity -> Bool) describe "U1 Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> U1 Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> U1 Int -> Bool) describe "Par1 Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> Par1 Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> Par1 Int -> Bool) describe "Rec1 Maybe Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> Rec1 Maybe Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> Rec1 Maybe Int -> Bool) describe "K1 () Int ()" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> K1 () Int () -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> K1 () Int () -> Bool) describe "M1 () () Maybe Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> M1 () () Maybe Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> M1 () () Maybe Int -> Bool) describe "(Maybe :+: Maybe) Int " $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> (Maybe :+: Maybe) Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> (Maybe :+: Maybe) Int -> Bool) describe "(Maybe :*: Maybe) Int " $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> (Maybe :*: Maybe) Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> (Maybe :*: Maybe) Int -> Bool) describe "(Maybe :.: Maybe) Int " $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> (Maybe :.: Maybe) Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> (Maybe :.: Maybe) Int -> Bool) text-show-2.1.1/tests/Spec/GHC/StatsSpec.hs0000644000000000000000000000143412575552406016562 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.GHC.StatsSpec Copyright: (C) 2014-2015 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 GHC.Stats (GCStats) import Spec.Utils (prop_matchesTextShow) import Test.Hspec (describe) import Test.Hspec.QuickCheck (prop) #endif main :: IO () main = hspec spec spec :: Spec spec = parallel $ #if MIN_VERSION_base(4,5,0) describe "GCStats" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> GCStats -> Bool) #else pure () #endif text-show-2.1.1/tests/Spec/GHC/FingerprintSpec.hs0000644000000000000000000000154212575552406017753 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.GHC.FingerprintSpec Copyright: (C) 2014-2015 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 GHC.Fingerprint.Type (Fingerprint) import Spec.Utils (prop_matchesTextShow) import Test.Hspec (describe) import Test.Hspec.QuickCheck (prop) #endif main :: IO () main = hspec spec spec :: Spec spec = parallel $ #if MIN_VERSION_base(4,4,0) describe "Fingerprint" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Fingerprint -> Bool) #else pure () #endif text-show-2.1.1/tests/Spec/GHC/RTS/0000755000000000000000000000000012575552406014763 5ustar0000000000000000text-show-2.1.1/tests/Spec/GHC/RTS/FlagsSpec.hs0000644000000000000000000000517712575552406017200 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.GHC.RTS.Flags Copyright: (C) 2014-2015 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 Instances.GHC.RTS.Flags () import Prelude () import Prelude.Compat import Test.Hspec (Spec, hspec, parallel) #if MIN_VERSION_base(4,8,0) import GHC.RTS.Flags import Spec.Utils (ioProperty, prop_matchesTextShow) import Test.Hspec (describe) import Test.Hspec.QuickCheck (prop) import Test.QuickCheck (Property) #endif main :: IO () main = hspec spec spec :: Spec spec = parallel $ do #if MIN_VERSION_base(4,8,0) describe "RTSFlags" $ prop "TextShow instance" prop_showRTSFlags describe "GCFlags" $ prop "TextShow instance" prop_showGCFlags describe "ConcFlags" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> ConcFlags -> Bool) describe "MiscFlags" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> MiscFlags -> Bool) describe "DebugFlags" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> DebugFlags -> Bool) describe "CCFlags" $ prop "TextShow instance" prop_showCCFlags describe "ProfFlags" $ prop "TextShow instance" prop_showProfFlags describe "TraceFlags" $ prop "TextShow instance" prop_showTraceFlags describe "TickyFlags" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> TickyFlags -> Bool) #else pure () #endif #if MIN_VERSION_base(4,8,0) -- | Verifies that the 'Show' instance for 'RTSFlags' is accurate. prop_showRTSFlags :: Int -> Property prop_showRTSFlags p = ioProperty $ do rtsflags <- getRTSFlags pure $ prop_matchesTextShow p rtsflags -- | Verifies that the 'Show' instance for 'GCFlags' is accurate. prop_showGCFlags :: Int -> Property prop_showGCFlags p = ioProperty $ do gcflags <- getGCFlags pure $ prop_matchesTextShow p gcflags -- | Verifies that the 'Show' instance for 'CCFlags' is accurate. prop_showCCFlags :: Int -> Property prop_showCCFlags p = ioProperty $ do ccflags <- getCCFlags pure $ prop_matchesTextShow p ccflags -- | Verifies that the 'Show' instance for 'ProfFlags' is accurate. prop_showProfFlags :: Int -> Property prop_showProfFlags p = ioProperty $ do profflags <- getProfFlags pure $ prop_matchesTextShow p profflags -- | Verifies that the 'Show' instance for 'TraceFlags' is accurate. prop_showTraceFlags :: Int -> Property prop_showTraceFlags p = ioProperty $ do traceflags <- getTraceFlags pure $ prop_matchesTextShow p traceflags #endif text-show-2.1.1/tests/Spec/GHC/Conc/0000755000000000000000000000000012575552406015175 5ustar0000000000000000text-show-2.1.1/tests/Spec/GHC/Conc/WindowsSpec.hs0000644000000000000000000000157412575552406020005 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.GHC.Conc.WindowsSpec Copyright: (C) 2014-2015 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 GHC.Conc.Windows (ConsoleEvent) import Spec.Utils (prop_matchesTextShow) import Test.Hspec (describe) import Test.Hspec.QuickCheck (prop) #endif main :: IO () main = hspec spec spec :: Spec spec = parallel $ #if !defined(__GHCJS__) && defined(mingw32_HOST_OS) describe "ConsoleEvent" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> ConsoleEvent -> Bool) #else pure () #endif text-show-2.1.1/tests/Spec/Text/0000755000000000000000000000000012575552406014636 5ustar0000000000000000text-show-2.1.1/tests/Spec/Text/ReadSpec.hs0000644000000000000000000000156012575552406016662 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Text.ReadSpec Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "Text.Read" module. -} module Spec.Text.ReadSpec (main, spec) where import Instances.Text.Read () import Spec.Utils (prop_matchesTextShow) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) import Text.Read (Lexeme) #if MIN_VERSION_base(4,7,0) import Text.Read.Lex (Number) #endif main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "Lexeme" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Lexeme -> Bool) #if MIN_VERSION_base(4,7,0) describe "Number" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Number -> Bool) #endif text-show-2.1.1/tests/Spec/Numeric/0000755000000000000000000000000012575552406015314 5ustar0000000000000000text-show-2.1.1/tests/Spec/Numeric/NaturalSpec.hs0000644000000000000000000000120212575552406020064 0ustar0000000000000000{-| Module: Spec.Numeric.NaturalSpec Copyright: (C) 2014-2015 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 Instances.Numeric.Natural () import Numeric.Natural (Natural) import Spec.Utils (prop_matchesTextShow) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Natural" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Natural -> Bool) text-show-2.1.1/tests/Spec/Control/0000755000000000000000000000000012575552406015332 5ustar0000000000000000text-show-2.1.1/tests/Spec/Control/ConcurrentSpec.hs0000644000000000000000000000232412575552406020624 0ustar0000000000000000{-| Module: Spec.Control.ConcurrentSpec Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "Control.Concurrent" module. -} module Spec.Control.ConcurrentSpec (main, spec) where import Control.Concurrent (myThreadId) import GHC.Conc (BlockReason, ThreadStatus) import Instances.Control.Concurrent () import Prelude () import Prelude.Compat import Spec.Utils (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" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> BlockReason -> Bool) describe "ThreadId" $ prop "TextShow instance" prop_showThreadId describe "ThreadStatus" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> ThreadStatus -> Bool) -- | 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-2.1.1/tests/Spec/Control/ExceptionSpec.hs0000644000000000000000000000612312575552406020441 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Control.ExceptionSpec Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "Control.Exception" module. -} module Spec.Control.ExceptionSpec (main, spec) where import Control.Exception import Instances.Control.Exception () import Spec.Utils (prop_matchesTextShow) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "TextShow.Control.Exception" $ do describe "SomeException" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> SomeException -> Bool) describe "IOException" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> IOException -> Bool) describe "ArithException" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> ArithException -> Bool) describe "ArrayException" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> ArrayException -> Bool) describe "AssertionFailed" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> AssertionFailed -> Bool) #if MIN_VERSION_base(4,7,0) describe "SomeAsyncException" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> SomeAsyncException -> Bool) #endif describe "AsyncException" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> AsyncException -> Bool) describe "NonTermination" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> NonTermination -> Bool) describe "NestedAtomically" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> NestedAtomically -> Bool) describe "BlockedIndefinitelyOnMVar" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> BlockedIndefinitelyOnMVar -> Bool) describe "BlockedIndefinitelyOnSTM" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> BlockedIndefinitelyOnSTM -> Bool) #if MIN_VERSION_base(4,8,0) describe "AllocationLimitExceeded" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> AllocationLimitExceeded -> Bool) #endif describe "Deadlock" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Deadlock -> Bool) describe "NoMethodError" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> NoMethodError -> Bool) describe "PatternMatchFail" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> PatternMatchFail -> Bool) describe "RecConError" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> RecConError -> Bool) describe "RecSelError" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> RecSelError -> Bool) describe "RecUpdError" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> RecUpdError -> Bool) describe "ErrorCall" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> ErrorCall -> Bool) describe "MaskingState" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> MaskingState -> Bool) text-show-2.1.1/tests/Spec/Control/ApplicativeSpec.hs0000644000000000000000000000222512575552406020743 0ustar0000000000000000{-| Module: Spec.Control.ApplicativeSpec Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "Control.Applicative" module. -} module Spec.Control.ApplicativeSpec (main, spec) where import Control.Applicative (Const, ZipList) import Data.Orphans () import Generics.Deriving.Instances () import Instances.Control.Applicative () import Spec.Utils (prop_matchesTextShow, prop_matchesTextShow2, prop_genericTextShow, prop_genericTextShow1) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "Const Int Int" $ prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> Const Int Int -> Bool) describe "ZipList Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> ZipList Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> ZipList Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> ZipList Int -> Bool) text-show-2.1.1/tests/Spec/Control/Monad/0000755000000000000000000000000012575552406016370 5ustar0000000000000000text-show-2.1.1/tests/Spec/Control/Monad/STSpec.hs0000644000000000000000000000064012575552406020065 0ustar0000000000000000module Spec.Control.Monad.STSpec (main, spec) where import Control.Monad.ST import Instances.Control.Monad.ST () import Spec.Utils (prop_matchesTextShow) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "ST Int Int" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> ST Int Int -> Bool) text-show-2.1.1/tests/Spec/Foreign/0000755000000000000000000000000012575552406015303 5ustar0000000000000000text-show-2.1.1/tests/Spec/Foreign/PtrSpec.hs0000644000000000000000000000263012575552406017220 0ustar0000000000000000{-| Module: Spec.Foreign.PtrSpec Copyright: (C) 2014-2015 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 Foreign.ForeignPtr (newForeignPtr_) import Foreign.Ptr (FunPtr, IntPtr, Ptr, WordPtr) import Instances.Foreign.Ptr () import Prelude () import Prelude.Compat import Spec.Utils (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" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Ptr Int -> Bool) describe "FunPtr Int" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> FunPtr Int -> Bool) describe "IntPtr" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> IntPtr -> Bool) describe "WordPtr" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> WordPtr -> Bool) 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-2.1.1/tests/Spec/Foreign/C/0000755000000000000000000000000012575552406015465 5ustar0000000000000000text-show-2.1.1/tests/Spec/Foreign/C/TypesSpec.hs0000644000000000000000000000632112575552406017742 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Foreign.C.TypesSpec Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "Foreign.C.Types" module. -} module Spec.Foreign.C.TypesSpec (main, spec) where import Foreign.C.Types import Instances.Foreign.C.Types () import Spec.Utils (prop_matchesTextShow) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "CChar" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CChar -> Bool) describe "CSChar" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CSChar -> Bool) describe "CUChar" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CUChar -> Bool) describe "CShort" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CShort -> Bool) describe "CUShort" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CUShort -> Bool) describe "CInt" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CInt -> Bool) describe "CUInt" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CUInt -> Bool) describe "CLong" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CLong -> Bool) describe "CULong" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CULong -> Bool) describe "CPtrdiff" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CPtrdiff -> Bool) describe "CSize" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CSize -> Bool) describe "CWchar" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CWchar -> Bool) describe "CSigAtomic" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CSigAtomic -> Bool) describe "CLLong" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CLLong -> Bool) describe "CULLong" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CULLong -> Bool) describe "CIntPtr" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CIntPtr -> Bool) describe "CUIntPtr" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CUIntPtr -> Bool) describe "CIntMax" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CIntMax -> Bool) describe "CUIntMax" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CUIntMax -> Bool) describe "CClock" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CClock -> Bool) describe "CTime" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CTime -> Bool) #if MIN_VERSION_base(4,4,0) describe "CUSeconds" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CUSeconds -> Bool) describe "CSUSeconds" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CSUSeconds -> Bool) #endif describe "CFloat" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CFloat -> Bool) describe "CDouble" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CDouble -> Bool) text-show-2.1.1/tests/Instances/0000755000000000000000000000000012575552406014747 5ustar0000000000000000text-show-2.1.1/tests/Instances/Generic.hs0000644000000000000000000000106312575552406016657 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Generic Copyright: (C) 2014-2015 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 Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..), oneof) import TextShow.Generic (ConType(..)) instance Arbitrary ConType where arbitrary = oneof [pure Rec, pure Tup, pure Pref, Inf <$> arbitrary] text-show-2.1.1/tests/Instances/Utils.hs0000644000000000000000000000061312575552406016403 0ustar0000000000000000{-| Module: Properties.Instances Copyright: (C) 2014-2015 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-2.1.1/tests/Instances/FromStringTextShow.hs0000644000000000000000000000213612575552406021105 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.FromStringTextShow Copyright: (C) 2014-2015 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(..)) import TransformersCompat (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-2.1.1/tests/Instances/Data/0000755000000000000000000000000012575552406015620 5ustar0000000000000000text-show-2.1.1/tests/Instances/Data/Monoid.hs0000644000000000000000000000200012575552406017371 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} #if MIN_VERSION_base(4,8,0) {-# LANGUAGE FlexibleContexts #-} #endif {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Monoid Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances for data types in the "Data.Monoid" module. -} module Instances.Data.Monoid () where import Data.Monoid import Test.QuickCheck (Arbitrary) deriving instance Arbitrary All deriving instance Arbitrary Any deriving instance Arbitrary a => Arbitrary (Dual a) deriving instance Arbitrary a => Arbitrary (First a) deriving instance Arbitrary a => Arbitrary (Last a) deriving instance Arbitrary a => Arbitrary (Product a) deriving instance Arbitrary a => Arbitrary (Sum a) #if MIN_VERSION_base(4,8,0) deriving instance Arbitrary (f a) => Arbitrary (Alt f a) #endif text-show-2.1.1/tests/Instances/Data/Version.hs0000644000000000000000000000077612575552406017613 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Version Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'Version'. -} module Instances.Data.Version () where import Data.Version (Version(..)) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) instance Arbitrary Version where arbitrary = Version <$> arbitrary <*> arbitrary text-show-2.1.1/tests/Instances/Data/ByteString.hs0000644000000000000000000000102612575552406020245 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.ByteString Copyright: (C) 2014-2015 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-2.1.1/tests/Instances/Data/Text.hs0000644000000000000000000000260512575552406017103 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Text Copyright: (C) 2014-2015 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 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 = DecodeError <$> arbitrary <*> arbitrary #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 text-show-2.1.1/tests/Instances/Data/Ord.hs0000644000000000000000000000076512575552406016710 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Ord Copyright: (C) 2014-2015 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-2.1.1/tests/Instances/Data/Dynamic.hs0000644000000000000000000000100312575552406017532 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Dynamic Copyright: (C) 2014-2015 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-2.1.1/tests/Instances/Data/OldTypeable.hs0000644000000000000000000000203112575552406020354 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,7,0) && !(MIN_VERSION_base(4,8,0)) {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} #endif {-| Module: Instances.Data.OldTypeable Copyright: (C) 2014-2015 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 Instances.GHC.Fingerprint () import Instances.Utils ((<@>)) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) instance Arbitrary TypeRep where arbitrary = TypeRep <$> arbitrary <*> arbitrary <@> [] -- arbitrary = TypeRep <$> arbitrary <*> arbitrary <*> arbitrary instance Arbitrary TyCon where arbitrary = TyCon <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary #endif text-show-2.1.1/tests/Instances/Data/Tuple.hs0000644000000000000000000001244612575552406017254 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Tuple Copyright: (C) 2014-2015 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 Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) instance ( Arbitrary a , Arbitrary b , Arbitrary c , Arbitrary d , Arbitrary e , Arbitrary f ) => Arbitrary (a, b, c, d, e, f) where arbitrary = (,,,,,) <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary instance ( Arbitrary a , Arbitrary b , Arbitrary c , Arbitrary d , Arbitrary e , Arbitrary f , Arbitrary g ) => Arbitrary (a, b, c, d, e, f, g) where arbitrary = (,,,,,,) <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary instance ( Arbitrary a , Arbitrary b , Arbitrary c , Arbitrary d , Arbitrary e , Arbitrary f , Arbitrary g , Arbitrary h ) => Arbitrary (a, b, c, d, e, f, g, h) where arbitrary = (,,,,,,,) <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary instance ( Arbitrary a , Arbitrary b , Arbitrary c , Arbitrary d , Arbitrary e , Arbitrary f , Arbitrary g , Arbitrary h , Arbitrary i ) => Arbitrary (a, b, c, d, e, f, g, h, i) where arbitrary = (,,,,,,,,) <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary instance ( Arbitrary a , Arbitrary b , Arbitrary c , Arbitrary d , Arbitrary e , Arbitrary f , Arbitrary g , Arbitrary h , Arbitrary i , Arbitrary j ) => Arbitrary (a, b, c, d, e, f, g, h, i, j) where arbitrary = (,,,,,,,,,) <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> 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 = (,,,,,,,,,,) <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> 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 l ) => Arbitrary (a, b, c, d, e, f, g, h, i, j, k, l) where arbitrary = (,,,,,,,,,,,) <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> 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 l , Arbitrary m ) => Arbitrary (a, b, c, d, e, f, g, h, i, j, k, l, m) where arbitrary = (,,,,,,,,,,,,) <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> 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 l , Arbitrary m , Arbitrary n ) => Arbitrary (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where arbitrary = (,,,,,,,,,,,,,) <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> 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 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 = (,,,,,,,,,,,,,,) <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary text-show-2.1.1/tests/Instances/Data/Char.hs0000644000000000000000000000074612575552406017040 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Char Copyright: (C) 2014-2015 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-2.1.1/tests/Instances/Data/Typeable.hs0000644000000000000000000000225412575552406017724 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Typeable Copyright: (C) 2014-2015 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 #if MIN_VERSION_base(4,4,0) import Data.Typeable.Internal (TyCon(..), TypeRep(..)) import Instances.Utils ((<@>)) #else import Data.Typeable (TyCon, TypeRep, mkTyCon, typeOf) import Test.QuickCheck (Gen) #endif import Instances.GHC.Fingerprint () import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) 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 instance Arbitrary TyCon where #if MIN_VERSION_base(4,4,0) arbitrary = TyCon <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary #else arbitrary = mkTyCon <$> arbitrary #endif text-show-2.1.1/tests/Instances/Data/Data.hs0000644000000000000000000000263712575552406017035 0ustar0000000000000000{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Data Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances for data types in the "Data.Data" module. -} module Instances.Data.Data () where import Data.Data (Constr, ConstrRep(..), DataRep(..), DataType, Fixity(..), mkConstr, mkDataType) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum, oneof) instance Arbitrary Constr where arbitrary = mkConstr <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary instance Arbitrary ConstrRep where arbitrary = oneof [ AlgConstr <$> arbitrary , IntConstr <$> arbitrary , FloatConstr <$> arbitrary , CharConstr <$> arbitrary ] instance Arbitrary DataRep where arbitrary = oneof [ AlgRep <$> arbitrary , pure IntRep , pure FloatRep , pure CharRep , pure NoRep ] instance Arbitrary DataType where arbitrary = mkDataType <$> arbitrary <*> arbitrary deriving instance Bounded Fixity deriving instance Enum Fixity instance Arbitrary Fixity where arbitrary = arbitraryBoundedEnum text-show-2.1.1/tests/Instances/Data/Proxy.hs0000644000000000000000000000106612575552406017300 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Proxy Copyright: (C) 2014-2015 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(..)) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) instance Arbitrary (Proxy s) where arbitrary = pure Proxy text-show-2.1.1/tests/Instances/Data/Floating.hs0000644000000000000000000000113712575552406017721 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Floating Copyright: (C) 2014-2015 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-2.1.1/tests/Instances/Data/Functor/0000755000000000000000000000000012575552406017240 5ustar0000000000000000text-show-2.1.1/tests/Instances/Data/Functor/Identity.hs0000644000000000000000000000105012575552406021361 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Functor.Identity Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'Identity'. -} module Instances.Data.Functor.Identity () where import Data.Functor.Identity (Identity(..)) import Test.QuickCheck (Arbitrary) deriving instance Arbitrary a => Arbitrary (Identity a) text-show-2.1.1/tests/Instances/Data/Type/0000755000000000000000000000000012575552406016541 5ustar0000000000000000text-show-2.1.1/tests/Instances/Data/Type/Coercion.hs0000644000000000000000000000125612575552406020642 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Type.Coercion Copyright: (C) 2014-2015 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 Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) instance Coercible a b => Arbitrary (Coercion a b) where arbitrary = pure Coercion #endif text-show-2.1.1/tests/Instances/Data/Type/Equality.hs0000644000000000000000000000130012575552406020664 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-2015 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 ((:~:)(..)) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) instance a ~ b => Arbitrary (a :~: b) where arbitrary = pure Refl #endif text-show-2.1.1/tests/Instances/System/0000755000000000000000000000000012575552406016233 5ustar0000000000000000text-show-2.1.1/tests/Instances/System/IO.hs0000644000000000000000000000373212575552406017103 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.System.IO Copyright: (C) 2014-2015 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 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 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 = HandlePosn <$> arbitrary <*> arbitrary deriving instance Bounded IOMode instance Arbitrary IOMode where arbitrary = arbitraryBoundedEnum instance Arbitrary BufferMode where arbitrary = oneof [ pure NoBuffering , pure LineBuffering , BlockBuffering <$> arbitrary ] 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 = NewlineMode <$> arbitrary <*> arbitrary text-show-2.1.1/tests/Instances/System/Exit.hs0000644000000000000000000000102512575552406017476 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.System.Exit Copyright: (C) 2014-2015 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 Prelude () import Prelude.Compat import System.Exit (ExitCode(..)) import Test.QuickCheck (Arbitrary(..), oneof) instance Arbitrary ExitCode where arbitrary = oneof [pure ExitSuccess, ExitFailure <$> arbitrary] text-show-2.1.1/tests/Instances/System/Posix/0000755000000000000000000000000012575552406017335 5ustar0000000000000000text-show-2.1.1/tests/Instances/System/Posix/Types.hs0000644000000000000000000000623512575552406021003 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.System.Posix.Types Copyright: (C) 2014-2015 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 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 deriving instance Arbitrary Fd text-show-2.1.1/tests/Instances/GHC/0000755000000000000000000000000012575552406015350 5ustar0000000000000000text-show-2.1.1/tests/Instances/GHC/Event.hs0000644000000000000000000000201212575552406016760 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.GHC.Event Copyright: (C) 2014-2015 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-2.1.1/tests/Instances/GHC/Stats.hs0000644000000000000000000000160512575552406017004 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.GHC.Stats Copyright: (C) 2014-2015 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.Stats (GCStats(..)) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) instance Arbitrary GCStats where arbitrary = GCStats <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary #endif text-show-2.1.1/tests/Instances/GHC/Generics.hs0000644000000000000000000000343612575552406017451 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.GHC.Generics Copyright: (C) 2014-2015 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 Generics.Deriving.Base (U1(..), Par1(..), Rec1(..), K1(..), M1(..), (:+:)(..), (:*:)(..), (:.:)(..), Fixity(..), Associativity(..), Arity(..)) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum, oneof) instance Arbitrary (U1 p) where arbitrary = pure U1 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 = oneof [L1 <$> arbitrary, R1 <$> arbitrary] instance (Arbitrary (f p), Arbitrary (g p)) => Arbitrary ((f :*: g) p) where arbitrary = (:*:) <$> arbitrary <*> arbitrary instance Arbitrary Fixity where arbitrary = oneof [pure Prefix, Infix <$> arbitrary <*> arbitrary] deriving instance Bounded Associativity deriving instance Enum Associativity instance Arbitrary Associativity where arbitrary = arbitraryBoundedEnum instance Arbitrary Arity where arbitrary = oneof [pure NoArity, Arity <$> arbitrary] text-show-2.1.1/tests/Instances/GHC/StaticPtr.hs0000644000000000000000000000110412575552406017615 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.GHC.StaticPtr Copyright: (C) 2014-2015 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.StaticPtr (StaticPtrInfo(..)) import Test.QuickCheck (Arbitrary(..)) instance Arbitrary StaticPtrInfo where arbitrary = StaticPtrInfo <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary #endif text-show-2.1.1/tests/Instances/GHC/TypeLits.hs0000644000000000000000000000242012575552406017457 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-2015 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-2.1.1/tests/Instances/GHC/Fingerprint.hs0000644000000000000000000000112412575552406020171 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.GHC.Fingerprint Copyright: (C) 2014-2015 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(..)) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) instance Arbitrary Fingerprint where arbitrary = Fingerprint <$> arbitrary <*> arbitrary #endif text-show-2.1.1/tests/Instances/GHC/RTS/0000755000000000000000000000000012575552406016020 5ustar0000000000000000text-show-2.1.1/tests/Instances/GHC/RTS/Flags.hs0000644000000000000000000000216512575552406017414 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.GHC.RTS.Flags Copyright: (C) 2014-2015 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 () where #if MIN_VERSION_base(4,8,0) import GHC.RTS.Flags import Test.QuickCheck (Arbitrary(..)) instance Arbitrary ConcFlags where arbitrary = ConcFlags <$> arbitrary <*> arbitrary instance Arbitrary MiscFlags where arbitrary = MiscFlags <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary instance Arbitrary DebugFlags where arbitrary = DebugFlags <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary instance Arbitrary TickyFlags where arbitrary = TickyFlags <$> arbitrary <*> arbitrary #endif text-show-2.1.1/tests/Instances/GHC/Conc/0000755000000000000000000000000012575552406016232 5ustar0000000000000000text-show-2.1.1/tests/Instances/GHC/Conc/Windows.hs0000644000000000000000000000124012575552406020215 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.GHC.Conc.Windows Copyright: (C) 2014-2015 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-2.1.1/tests/Instances/Text/0000755000000000000000000000000012575552406015673 5ustar0000000000000000text-show-2.1.1/tests/Instances/Text/Read.hs0000644000000000000000000000424312575552406017105 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Text.Read Copyright: (C) 2014-2015 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 Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..), oneof) import Text.Read (Lexeme(..)) #if MIN_VERSION_base(4,7,0) import Data.Fixed (Fixed, E12) import Numeric (showEFloat, showFFloat, showGFloat, showHex, showOct) import Test.QuickCheck (Gen, getNonNegative) import Text.Read.Lex (Number) #endif instance Arbitrary Lexeme where arbitrary = oneof [ Char <$> arbitrary , String <$> arbitrary , Punc <$> arbitrary , Ident <$> arbitrary , Symbol <$> arbitrary #if MIN_VERSION_base(4,7,0) , Number <$> arbitrary #elif !(MIN_VERSION_base(4,6,0)) , Int <$> arbitrary , Rat <$> arbitrary #endif , pure EOF ] #if MIN_VERSION_base(4,7,0) instance Arbitrary Number where arbitrary = do str <- oneof [ show <$> (nonneg :: Gen Double) , fmap (\d -> showEFloat Nothing d "") (nonneg :: Gen Double) , fmap (\d -> showFFloat Nothing d "") (nonneg :: Gen Double) , fmap (\d -> showGFloat Nothing d "") (nonneg :: Gen Double) , show <$> (nonneg :: Gen Float) , show <$> (nonneg :: Gen Int) , fmap (\i -> "0x" ++ showHex i "") (nonneg :: Gen Int) , fmap (\i -> "0o" ++ showOct i "") (nonneg :: Gen Int) , show <$> (nonneg :: Gen Integer) , show <$> (nonneg :: Gen Word) , show <$> (nonneg :: Gen (Fixed E12)) ] let Number num = read str pure num where nonneg :: (Arbitrary a, Num a, Ord a) => Gen a nonneg = getNonNegative <$> arbitrary #endif text-show-2.1.1/tests/Instances/Numeric/0000755000000000000000000000000012575552406016351 5ustar0000000000000000text-show-2.1.1/tests/Instances/Numeric/Natural.hs0000644000000000000000000000206312575552406020314 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Numeric.Natural Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance 'Natural' (if one isn't already defined). -} module Instances.Numeric.Natural () where -- Copied from @QuickCheck@ #if !(MIN_VERSION_QuickCheck(2,8,0)) || !(MIN_VERSION_base(4,8,0)) import Numeric.Natural (Natural) import Test.QuickCheck (Arbitrary(..), Gen, choose, shrinkIntegral, sized, suchThat) instance Arbitrary Natural where arbitrary = arbitrarySizedNatural shrink = shrinkIntegral -- | Generates a natural number. The number's maximum value depends on -- the size parameter. arbitrarySizedNatural :: Integral a => Gen a arbitrarySizedNatural = sized $ \n -> inBounds fromInteger (choose (0, toInteger n)) inBounds :: Integral a => (Integer -> a) -> Gen Integer -> Gen a inBounds fi g = fmap fi (g `suchThat` (\x -> toInteger (fi x) == x)) #endif text-show-2.1.1/tests/Instances/Control/0000755000000000000000000000000012575552406016367 5ustar0000000000000000text-show-2.1.1/tests/Instances/Control/Exception.hs0000644000000000000000000000611512575552406020664 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Control.Exception Copyright: (C) 2014-2015 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 import GHC.IO.Exception (IOException(..), IOErrorType(..)) import Instances.Foreign.C.Types () import Instances.System.IO () import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..), Gen, arbitraryBoundedEnum, oneof) instance Arbitrary SomeException where arbitrary = SomeException <$> (arbitrary :: Gen AssertionFailed) instance Arbitrary IOException where arbitrary = IOError <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary 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 = oneof [ IndexOutOfBounds <$> arbitrary , UndefinedElement <$> arbitrary ] instance Arbitrary AssertionFailed where arbitrary = AssertionFailed <$> arbitrary #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 instance Arbitrary NonTermination where arbitrary = pure NonTermination instance Arbitrary NestedAtomically where arbitrary = pure NestedAtomically instance Arbitrary BlockedIndefinitelyOnMVar where arbitrary = pure BlockedIndefinitelyOnMVar instance Arbitrary BlockedIndefinitelyOnSTM where arbitrary = pure BlockedIndefinitelyOnSTM #if MIN_VERSION_base(4,8,0) instance Arbitrary AllocationLimitExceeded where arbitrary = pure AllocationLimitExceeded #endif instance Arbitrary Deadlock where arbitrary = pure Deadlock instance Arbitrary NoMethodError where arbitrary = NoMethodError <$> arbitrary instance Arbitrary PatternMatchFail where arbitrary = PatternMatchFail <$> arbitrary instance Arbitrary RecConError where arbitrary = RecConError <$> arbitrary instance Arbitrary RecSelError where arbitrary = RecSelError <$> arbitrary instance Arbitrary RecUpdError where arbitrary = RecUpdError <$> arbitrary instance Arbitrary ErrorCall where #if MIN_VERSION_base(4,8,2) arbitrary = ErrorCallWithLocation <$> arbitrary <*> arbitrary #else arbitrary = ErrorCall <$> arbitrary #endif deriving instance Bounded MaskingState deriving instance Enum MaskingState instance Arbitrary MaskingState where arbitrary = arbitraryBoundedEnum text-show-2.1.1/tests/Instances/Control/Concurrent.hs0000644000000000000000000000166212575552406021052 0ustar0000000000000000{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Control.Concurrent Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances for data types in the "Control.Concurrent" module. -} module Instances.Control.Concurrent () where import GHC.Conc (BlockReason(..), ThreadStatus(..)) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum, oneof) deriving instance Bounded BlockReason deriving instance Enum BlockReason instance Arbitrary BlockReason where arbitrary = arbitraryBoundedEnum instance Arbitrary ThreadStatus where arbitrary = oneof [ pure ThreadRunning , pure ThreadFinished , ThreadBlocked <$> arbitrary , pure ThreadDied ] text-show-2.1.1/tests/Instances/Control/Applicative.hs0000644000000000000000000000120712575552406021164 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Control.Applicative Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances for data types in the "Control.Applicative" module. -} module Instances.Control.Applicative () where import Control.Applicative (Const(..), ZipList(..)) import Test.QuickCheck (Arbitrary) deriving instance Arbitrary a => Arbitrary (Const a b) deriving instance Arbitrary a => Arbitrary (ZipList a) text-show-2.1.1/tests/Instances/Control/Monad/0000755000000000000000000000000012575552406017425 5ustar0000000000000000text-show-2.1.1/tests/Instances/Control/Monad/ST.hs0000644000000000000000000000076712575552406020321 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Control.Monad.ST Copyright: (C) 2014-2015 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-2.1.1/tests/Instances/Foreign/0000755000000000000000000000000012575552406016340 5ustar0000000000000000text-show-2.1.1/tests/Instances/Foreign/Ptr.hs0000644000000000000000000000154112575552406017442 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Foreign.Ptr Copyright: (C) 2014-2015 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-2.1.1/tests/Instances/Foreign/C/0000755000000000000000000000000012575552406016522 5ustar0000000000000000text-show-2.1.1/tests/Instances/Foreign/C/Types.hs0000644000000000000000000000746712575552406020200 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-2015 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 # if MIN_VERSION_base(4,4,0) deriving instance Arbitrary CUSeconds deriving instance Arbitrary CSUSeconds # endif deriving instance Arbitrary CIntPtr deriving instance Arbitrary CUIntPtr deriving instance Arbitrary CIntMax deriving instance Arbitrary CUIntMax #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-2.1.1/src/0000755000000000000000000000000012575552406012445 5ustar0000000000000000text-show-2.1.1/src/TextShow.hs0000644000000000000000000000265512575552406014576 0ustar0000000000000000{-| Module: TextShow Copyright: (C) 2014-2015 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(..) , showt , showtl , showtPrec , showtlPrec , showtList , showtlList , showbParen , showbSpace -- ** 'TextShow1' , TextShow1(..) , showbPrec1 , showbUnaryWith -- ** 'TextShow2' , TextShow2(..) , showbPrec2 , showbBinaryWith -- * '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 -- * Conversion between 'TextShow' and string @Show@ , FromStringShow(..) , FromTextShow(..) , showsToShowb , showbToShows ) where 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-2.1.1/src/TextShow/0000755000000000000000000000000012575552406014232 5ustar0000000000000000text-show-2.1.1/src/TextShow/Generic.hs0000644000000000000000000003306312575552406016147 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #else {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif #if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE StandaloneDeriving #-} #endif {-| Module: TextShow.Generic Copyright: (C) 2014-2015 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 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 , genericShowbPrecWith , genericShowbPrec1 -- * The 'GTextShow' and 'GTextShow1' classes , GTextShow(..) , GTextShow1(..) , ConType(..) ) where import Data.Monoid.Compat ((<>)) import qualified Data.Text as TS (Text) import qualified Data.Text.IO as TS (putStrLn, hPutStrLn) import Data.Text.Lazy (toStrict) import Data.Text.Lazy.Builder (Builder, fromString, singleton, toLazyText) import qualified Data.Text.Lazy as TL (Text) import qualified Data.Text.Lazy.IO as TL (putStrLn, hPutStrLn) import Data.Typeable (Typeable) import Generics.Deriving.Base #if __GLASGOW_HASKELL__ < 702 import qualified Generics.Deriving.TH as Generics (deriveAll) #endif import GHC.Show (appPrec, appPrec1) import Prelude () import Prelude.Compat import System.IO (Handle) import TextShow.Classes (TextShow(showbPrec), TextShow1(..), showbListWith, showbParen, showbSpace) import TextShow.Instances () import TextShow.Utils (isInfixTypeCon, isTupleString) #include "inline.h" {- $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 showbPrecWith = 'genericShowbPrecWith' @ -} {- $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 will get an error message that begins roughly as follows: @ No instance for ('GTextShow' (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 @('GTextShow1' (Rep1 Oops1))@, add a \"@deriving 'Generic1'@\" clause. -} -- | A 'Generic' implementation of 'showt'. -- -- /Since: 2/ genericShowt :: (Generic a, GTextShow (Rep a)) => a -> TS.Text genericShowt = toStrict . genericShowtl -- | A 'Generic' implementation of 'showtl'. -- -- /Since: 2/ genericShowtl :: (Generic a, GTextShow (Rep a)) => a -> TL.Text genericShowtl = toLazyText . genericShowb -- | A 'Generic' implementation of 'showPrect'. -- -- /Since: 2/ genericShowtPrec :: (Generic a, GTextShow (Rep a)) => Int -> a -> TS.Text genericShowtPrec p = toStrict . genericShowtlPrec p -- | A 'Generic' implementation of 'showtlPrec'. -- -- /Since: 2/ genericShowtlPrec :: (Generic a, GTextShow (Rep a)) => Int -> a -> TL.Text genericShowtlPrec p = toLazyText . genericShowbPrec p -- | A 'Generic' implementation of 'showtList'. -- -- /Since: 2/ genericShowtList :: (Generic a, GTextShow (Rep a)) => [a] -> TS.Text genericShowtList = toStrict . genericShowtlList -- | A 'Generic' implementation of 'showtlList'. -- -- /Since: 2/ genericShowtlList :: (Generic a, GTextShow (Rep a)) => [a] -> TL.Text genericShowtlList = toLazyText . genericShowbList -- | A 'Generic' implementation of 'showb'. -- -- /Since: 2/ genericShowb :: (Generic a, GTextShow (Rep a)) => a -> Builder genericShowb = genericShowbPrec 0 -- | A 'Generic' implementation of 'showbPrec'. -- -- /Since: 2/ genericShowbPrec :: (Generic a, GTextShow (Rep a)) => Int -> a -> Builder genericShowbPrec p = gShowbPrec Pref p . from -- | A 'Generic' implementation of 'showbList'. -- -- /Since: 2/ genericShowbList :: (Generic a, GTextShow (Rep a)) => [a] -> Builder genericShowbList = showbListWith genericShowb -- | A 'Generic' implementation of 'printT'. -- -- /Since: 2/ genericPrintT :: (Generic a, GTextShow (Rep a)) => a -> IO () genericPrintT = TS.putStrLn . genericShowt -- | A 'Generic' implementation of 'printTL'. -- -- /Since: 2/ genericPrintTL :: (Generic a, GTextShow (Rep a)) => a -> IO () genericPrintTL = TL.putStrLn . genericShowtl -- | A 'Generic' implementation of 'hPrintT'. -- -- /Since: 2/ genericHPrintT :: (Generic a, GTextShow (Rep a)) => Handle -> a -> IO () genericHPrintT h = TS.hPutStrLn h . genericShowt -- | A 'Generic' implementation of 'hPrintTL'. -- -- /Since: 2/ genericHPrintTL :: (Generic a, GTextShow (Rep a)) => Handle -> a -> IO () genericHPrintTL h = TL.hPutStrLn h . genericShowtl -- | A 'Generic1' implementation of 'showbPrecWith'. -- -- /Since: 2/ genericShowbPrecWith :: (Generic1 f, GTextShow1 (Rep1 f)) => (Int -> a -> Builder) -> Int -> f a -> Builder genericShowbPrecWith sp p = gShowbPrecWith Pref sp p . from1 -- | A 'Generic'/'Generic1' implementation of 'showbPrec1'. -- -- /Since: 2/ genericShowbPrec1 :: (Generic a, Generic1 f, GTextShow (Rep a), GTextShow1 (Rep1 f)) => Int -> f a -> Builder genericShowbPrec1 = genericShowbPrecWith genericShowbPrec ------------------------------------------------------------------------------- -- | 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 ( Eq , Ord , Read , Show , Typeable #if __GLASGOW_HASKELL__ >= 702 , Generic #endif ) instance TextShow ConType where showbPrec = genericShowbPrec INLINE_INST_FUN(showbPrec) -- | Class of generic representation types ('Rep') that can be converted to -- a 'Builder'. -- -- /Since: 2/ class GTextShow f where -- | This is used as the default generic implementation of 'showbPrec'. gShowbPrec :: ConType -> Int -> f a -> Builder -- | Whether a representation type has any constructors. isNullary :: f a -> Bool isNullary = error "generic showbPrec (isNullary): unnecessary case" #if __GLASGOW_HASKELL__ >= 708 {-# MINIMAL gShowbPrec #-} deriving instance Typeable GTextShow #endif instance GTextShow U1 where gShowbPrec _ _ U1 = mempty isNullary _ = True instance TextShow c => GTextShow (K1 i c) where gShowbPrec _ n (K1 a) = showbPrec n a isNullary _ = False instance (Constructor c, GTextShow f) => GTextShow (C1 c f) where gShowbPrec = gShowbConstructor gShowbPrec isNullary instance (Selector s, GTextShow f) => GTextShow (S1 s f) where gShowbPrec = gShowbSelector gShowbPrec isNullary (M1 x) = isNullary x instance GTextShow f => GTextShow (D1 d f) where gShowbPrec t n (M1 x) = gShowbPrec t n x instance (GTextShow f, GTextShow g) => GTextShow (f :+: g) where gShowbPrec t n (L1 x) = gShowbPrec t n x gShowbPrec t n (R1 x) = gShowbPrec t n x instance (GTextShow f, GTextShow g) => GTextShow (f :*: g) where gShowbPrec = gShowbProduct gShowbPrec gShowbPrec -- If we have a product then it is not a nullary constructor isNullary _ = False ------------------------------------------------------------------------------- -- | Class of generic representation types ('Rep1') that can be converted to -- a 'Builder' by lifting through a unary type constructor. -- -- /Since: 2/ class GTextShow1 f where -- | This is used as the default generic implementation of 'showbPrecWith'. gShowbPrecWith :: ConType -> (Int -> a -> Builder) -> Int -> f a -> Builder -- | Whether a representation type has any constructors. isNullary1 :: f a -> Bool isNullary1 = error "generic showbPrecWith (isNullary1): unnecessary case" #if __GLASGOW_HASKELL__ >= 708 {-# MINIMAL gShowbPrecWith #-} deriving instance Typeable GTextShow1 #endif instance GTextShow1 U1 where gShowbPrecWith _ _ _ U1 = mempty isNullary1 _ = True instance GTextShow1 Par1 where gShowbPrecWith _ sp n (Par1 p) = sp n p isNullary1 _ = False instance TextShow c => GTextShow1 (K1 i c) where gShowbPrecWith _ _ n (K1 a) = showbPrec n a isNullary1 _ = False instance TextShow1 f => GTextShow1 (Rec1 f) where gShowbPrecWith _ sp n (Rec1 r) = showbPrecWith sp n r isNullary1 _ = False instance (Constructor c, GTextShow1 f) => GTextShow1 (C1 c f) where gShowbPrecWith t sp = gShowbConstructor (flip gShowbPrecWith sp) isNullary1 t instance (Selector s, GTextShow1 f) => GTextShow1 (S1 s f) where gShowbPrecWith t sp = gShowbSelector (flip gShowbPrecWith sp) t isNullary1 (M1 x) = isNullary1 x instance GTextShow1 f => GTextShow1 (D1 d f) where gShowbPrecWith t sp n (M1 x) = gShowbPrecWith t sp n x instance (GTextShow1 f, GTextShow1 g) => GTextShow1 (f :+: g) where gShowbPrecWith t sp n (L1 x) = gShowbPrecWith t sp n x gShowbPrecWith t sp n (R1 x) = gShowbPrecWith t sp n x instance (GTextShow1 f, GTextShow1 g) => GTextShow1 (f :*: g) where gShowbPrecWith t sp = gShowbProduct (flip gShowbPrecWith sp) (flip gShowbPrecWith sp) t -- If we have a product then it is not a nullary constructor isNullary1 _ = False instance (TextShow1 f, GTextShow1 g) => GTextShow1 (f :.: g) where gShowbPrecWith t sp n (Comp1 c) = showbPrecWith (gShowbPrecWith t sp) n c isNullary1 _ = False ------------------------------------------------------------------------------- -- Shared code between GTextShow and GTextShow1 ------------------------------------------------------------------------------- gShowbConstructor :: forall c f p. Constructor c => (ConType -> Int -> f p -> Builder) -> (f p -> Bool) -> ConType -> Int -> C1 c f p -> Builder gShowbConstructor gs isNull _ n c@(M1 x) = case fixity of Prefix -> showbParen ( n > appPrec && not ( isNull x || conIsTuple c #if __GLASGOW_HASKELL__ >= 711 || conIsRecord c #endif ) ) $ (if conIsTuple c then mempty else let cn = conName c in showbParen (isInfixTypeCon cn) $ fromString cn ) <> (if isNull x || conIsTuple c then mempty else singleton ' ' ) <> showbBraces t (gs t appPrec1 x) Infix _ m -> showbParen (n > m) . showbBraces t $ gs t (m+1) x where fixity :: Fixity fixity = conFixity c t :: ConType t = if conIsRecord c then Rec else case conIsTuple c of True -> Tup False -> case fixity of Prefix -> Pref Infix _ _ -> Inf $ conName c showbBraces :: ConType -> Builder -> Builder showbBraces Rec b = singleton '{' <> b <> singleton '}' showbBraces Tup b = singleton '(' <> b <> singleton ')' showbBraces Pref b = b showbBraces (Inf _) b = b conIsTuple :: C1 c f p -> Bool conIsTuple = isTupleString . conName gShowbSelector :: Selector s => (ConType -> Int -> f p -> Builder) -> ConType -> Int -> S1 s f p -> Builder gShowbSelector gs t n sel@(M1 x) | selName sel == "" = gs t n x | otherwise = fromString (selName sel) <> " = " <> gs t 0 x gShowbProduct :: (ConType -> Int -> f p -> Builder) -> (ConType -> Int -> g p -> Builder) -> ConType -> Int -> ((f :*: g) p) -> Builder gShowbProduct gsa gsb t@Rec _ (a :*: b) = gsa t 0 a <> ", " <> gsb t 0 b gShowbProduct gsa gsb t@(Inf o) n (a :*: b) = gsa t n a <> showbSpace <> infixOp <> showbSpace <> gsb t n b where infixOp :: Builder infixOp = if isInfixTypeCon o then fromString o else singleton '`' <> fromString o <> singleton '`' gShowbProduct gsa gsb t@Tup _ (a :*: b) = gsa t 0 a <> singleton ',' <> gsb t 0 b gShowbProduct gsa gsb t@Pref n (a :*: b) = gsa t n a <> showbSpace <> gsb t n b ------------------------------------------------------------------------------- #if __GLASGOW_HASKELL__ < 702 $(Generics.deriveAll ''ConType) #endif text-show-2.1.1/src/TextShow/Instances.hs0000644000000000000000000000432112575552406016515 0ustar0000000000000000{-| Module: TextShow.Instances Copyright: (C) 2014-2015 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.Identity () import TextShow.Data.Integral () import TextShow.Data.List () 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.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.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-2.1.1/src/TextShow/Functions.hs0000644000000000000000000000203512575552406016536 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Functions Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Optional 'TextShow', 'TextShow1', and 'TextShow2' instances for functions. /Since: 2/ -} module TextShow.Functions (showbFunction) where import Data.Text.Lazy.Builder (Builder) import TextShow.Classes (TextShow(showb, showbPrec), TextShow1(..), TextShow2(..)) #include "inline.h" -- | Convert a function to a 'Builder'. -- -- /Since: 2/ showbFunction :: (a -> b) -> Builder showbFunction = showb {-# INLINE showbFunction #-} instance TextShow (a -> b) where showbPrec = showbPrecWith undefined INLINE_INST_FUN(showbPrec) instance TextShow1 ((->) a) where showbPrecWith = showbPrecWith2 undefined INLINE_INST_FUN(showbPrecWith) instance TextShow2 (->) where showbPrecWith2 _ _ _ _ = "" INLINE_INST_FUN(showbPrecWith2) text-show-2.1.1/src/TextShow/Utils.hs0000644000000000000000000000507412575552406015674 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-| Module: TextShow.Utils Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Miscellaneous utility functions. -} module TextShow.Utils ( i2d , isInfixTypeCon , isTupleString , lengthB , mtimesDefault , toString , toText , unlinesB , unwordsB ) where import Data.Int (Int64) import Data.Text (Text) import Data.Monoid.Compat ((<>)) #if MIN_VERSION_semigroups(0,17,0) import Data.Semigroup (mtimesDefault) #else import Data.Semigroup (timesN) #endif import Data.Text.Lazy (length, toStrict, unpack) import Data.Text.Lazy.Builder (Builder, singleton, toLazyText) import GHC.Exts (Char(C#), Int(I#)) import GHC.Prim ((+#), chr#, ord#) import Prelude () import Prelude.Compat hiding (length) -- | 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 type constructor (i.e., does -- it begin with a colon?). isInfixTypeCon :: String -> Bool isInfixTypeCon (':':_) = True isInfixTypeCon _ = False {-# INLINE isInfixTypeCon #-} -- | 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 #-} #if !(MIN_VERSION_semigroups(0,17,0)) -- | Repeat a value @n@ times. -- -- > mtimesDefault n a = a <> a <> ... <> a -- using <> (n-1) times mtimesDefault :: (Integral b, Monoid a) => b -> a -> a mtimesDefault = timesN . fromIntegral {-# INLINE mtimesDefault #-} #endif -- | Convert a 'Builder' to a 'String' (without surrounding it with double quotes, -- as 'show' would). -- -- /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-2.1.1/src/TextShow/FromStringTextShow.hs0000644000000000000000000000743212575552406020374 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #else {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #endif #if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE AutoDeriveTypeable #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} #endif {-| Module: TextShow.FromStringTextShow Copyright: (C) 2014-2015 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(..)) where import Data.Data (Data, Typeable) #if __GLASGOW_HASKELL__ >= 702 import GHC.Generics (Generic) # if __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic1) # endif #else import qualified Generics.Deriving.TH as Generics (deriveAll) #endif import Prelude () import Prelude.Compat import Text.Read (Read(..), readListPrecDefault) import TextShow.Classes (TextShow(..), TextShow1(..), showbToShows, showsToShowb) #include "inline.h" -- | 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__ >= 702 , Generic # if __GLASGOW_HASKELL__ >= 706 , Generic1 # endif #endif , Ord , Traversable , Typeable ) instance Read a => Read (FromStringShow a) where readPrec = FromStringShow <$> readPrec INLINE_INST_FUN(readPrec) readListPrec = readListPrecDefault INLINE_INST_FUN(readListPrec) instance Show a => TextShow (FromStringShow a) where showbPrec p = showsToShowb showsPrec p . fromStringShow INLINE_INST_FUN(showbPrec) instance Show a => Show (FromStringShow a) where showsPrec p = showsPrec p . fromStringShow INLINE_INST_FUN(showsPrec) instance TextShow1 FromStringShow where showbPrecWith sp p = showsToShowb (showbToShows sp) p . fromStringShow INLINE_INST_FUN(showbPrecWith) -- | 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__ >= 702 , Generic # if __GLASGOW_HASKELL__ >= 706 , Generic1 # endif #endif , Ord , TextShow , Traversable , Typeable ) instance Read a => Read (FromTextShow a) where readPrec = FromTextShow <$> readPrec INLINE_INST_FUN(readPrec) readListPrec = readListPrecDefault INLINE_INST_FUN(readListPrec) instance TextShow a => Show (FromTextShow a) where showsPrec p = showbToShows showbPrec p . fromTextShow INLINE_INST_FUN(showsPrec) instance TextShow1 FromTextShow where showbPrecWith sp p = sp p . fromTextShow INLINE_INST_FUN(showbPrecWith) ------------------------------------------------------------------------------- #if __GLASGOW_HASKELL__ < 702 $(Generics.deriveAll ''FromStringShow) $(Generics.deriveAll ''FromTextShow) #endif text-show-2.1.1/src/TextShow/TH.hs0000644000000000000000000000104312575552406015077 0ustar0000000000000000{-| Module: TextShow.TH Copyright: (C) 2014-2015 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 text-show-2.1.1/src/TextShow/Classes.hs0000644000000000000000000002131612575552406016166 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} #if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE StandaloneDeriving #-} #endif {-| Module: TextShow.Classes Copyright: (C) 2014-2015 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 Data.Text as TS (Text) import qualified Data.Text.IO as TS (putStrLn, hPutStrLn) import qualified Data.Text.Lazy as TL (Text) import qualified Data.Text.Lazy.IO as TL (putStrLn, hPutStrLn) import Data.Text.Lazy (toStrict) import Data.Text.Lazy.Builder (Builder, fromString, singleton, toLazyText) import GHC.Show (appPrec, appPrec1) import System.IO (Handle) import TextShow.Utils (toString) ------------------------------------------------------------------------------- -- | 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 'String'. -> Builder showbPrec _ = showb -- | A specialized variant of 'showbPrec' using precedence context zero. -- -- /Since: 2/ showb :: a -> Builder showb = showbPrec 0 -- | Allows for specialized display of lists. This is used, for example, when -- showing lists of 'Char's. -- -- /Since: 2/ showbList :: [a] -> Builder showbList = showbListWith showb #if __GLASGOW_HASKELL__ >= 708 {-# MINIMAL showbPrec | showb #-} deriving instance Typeable TextShow #endif -- | Constructs a strict 'TS.Text' from a single value. -- -- /Since: 2/ showt :: TextShow a => a -> TS.Text showt = toStrict . showtl {-# INLINE showt #-} -- | Constructs a lazy 'TL.Text' from a single value. -- -- /Since: 2/ showtl :: TextShow a => a -> TL.Text showtl = toLazyText . showb {-# INLINE showtl #-} -- | Constructs a strict 'TS.Text' from a single value with the given precedence. -- -- /Since: 2/ showtPrec :: TextShow a => Int -> a -> TS.Text showtPrec p = toStrict . showtlPrec p {-# INLINE showtPrec #-} -- | Constructs a lazy 'TL.Text' from a single value with the given precedence. -- -- /Since: 2/ showtlPrec :: TextShow a => Int -> a -> TL.Text showtlPrec p = toLazyText . showbPrec p {-# INLINE showtlPrec #-} -- | Construct a strict 'TS.Text' from a list of values. -- -- /Since: 2/ showtList :: TextShow a => [a] -> TS.Text showtList = toStrict . showtlList {-# INLINE showtList #-} -- | Construct a lazy 'TL.Text' from a list of values. -- -- /Since: 2/ showtlList :: TextShow a => [a] -> TL.Text showtlList = toLazyText . showbList {-# INLINE showtlList #-} -- | 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 {-# INLINE showbParen #-} -- | 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 ']' -- ..]" {-# INLINE showbListWith #-} -- | 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 @ShowS@-based show function to a @Builder@-based one. -- -- /Since: 2.1/ showsToShowb :: (Int -> a -> ShowS) -> Int -> a -> Builder showsToShowb sp p x = fromString $ sp p x "" {-# INLINE showsToShowb #-} -- | Convert a @Builder@-based show function to a @ShowS@-based one. -- -- /Since: 2.1/ showbToShows :: (Int -> a -> Builder) -> Int -> a -> ShowS showbToShows sp p = showString . toString . sp p {-# INLINE showbToShows #-} ------------------------------------------------------------------------------- -- | Lifting of the 'TextShow' class to unary type constructors. -- -- /Since: 2/ class TextShow1 f where -- | Lifts a 'showbPrec' function through the type constructor. -- -- /Since: 2/ showbPrecWith :: (Int -> a -> Builder) -> Int -> f a -> Builder #if __GLASGOW_HASKELL__ >= 708 deriving instance Typeable TextShow1 #endif -- | Lift the standard 'showbPrec' function through the type constructor. -- -- /Since: 2/ showbPrec1 :: (TextShow1 f, TextShow a) => Int -> f a -> Builder showbPrec1 = showbPrecWith showbPrec {-# 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 #-} ------------------------------------------------------------------------------- -- | Lifting of the 'TextShow' class to binary type constructors. -- -- /Since: 2/ class TextShow2 f where -- | Lifts 'showbPrec' functions through the type constructor. -- -- /Since: 2/ showbPrecWith2 :: (Int -> a -> Builder) -> (Int -> b -> Builder) -> Int -> f a b -> Builder #if __GLASGOW_HASKELL__ >= 708 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 = showbPrecWith2 showbPrec showbPrec {-# 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 #-} text-show-2.1.1/src/TextShow/Data/0000755000000000000000000000000012575552406015103 5ustar0000000000000000text-show-2.1.1/src/TextShow/Data/Maybe.hs0000644000000000000000000000156212575552406016500 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Maybe Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' function for 'Maybe' values. /Since: 2/ -} module TextShow.Data.Maybe (showbMaybePrecWith) where import Data.Text.Lazy.Builder (Builder) import TextShow.Classes (showbPrecWith) import TextShow.TH.Internal (deriveTextShow, deriveTextShow1) #include "inline.h" -- | Convert a 'Maybe' value to a 'Builder' with the given show function and precedence. -- -- /Since: 2/ showbMaybePrecWith :: (Int -> a -> Builder) -> Int -> Maybe a -> Builder showbMaybePrecWith = showbPrecWith {-# INLINE showbMaybePrecWith #-} $(deriveTextShow ''Maybe) $(deriveTextShow1 ''Maybe) text-show-2.1.1/src/TextShow/Data/Void.hs0000644000000000000000000000127612575552406016346 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Void Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' function for 'Void' values. /Since: 2/ -} module TextShow.Data.Void (showbVoid) where import Data.Text.Lazy.Builder (Builder) import Data.Void (Void, absurd) import Prelude () import TextShow.Classes (TextShow(showb)) -- | Since 'Void' values logically don't exist, attempting to convert one to a -- 'Builder' will never terminate. -- -- /Since: 2/ showbVoid :: Void -> Builder showbVoid = absurd instance TextShow Void where showb = showbVoid text-show-2.1.1/src/TextShow/Data/Monoid.hs0000644000000000000000000000737012575552406016673 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-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'Show' functions for 'Monoid'-related newtypes. /Since: 2/ -} module TextShow.Data.Monoid ( showbAllPrec , showbAnyPrec , showbDualPrecWith , showbFirstPrecWith , showbLastPrecWith , showbProductPrecWith , showbSumPrecWith #if MIN_VERSION_base(4,8,0) , showbAltPrec , showbAltPrecWith #endif ) where import Data.Monoid.Compat (All, Any, Dual, First, Last, Product, Sum) import Data.Text.Lazy.Builder (Builder) import TextShow.Classes (TextShow(showbPrec), showbPrecWith) import TextShow.Data.Bool () import TextShow.Data.Maybe () import TextShow.TH.Internal (deriveTextShow, deriveTextShow1) #if MIN_VERSION_base(4,8,0) import Data.Monoid (Alt) import TextShow.Classes (TextShow1) import TextShow.TH.Internal (makeShowbPrec) #endif #include "inline.h" -- | Convert an 'All' value to a 'Builder' with the given precedence. -- -- /Since: 2/ showbAllPrec :: Int -> All -> Builder showbAllPrec = showbPrec {-# INLINE showbAllPrec #-} -- | Convert an 'Any' value to a 'Builder' with the given precedence. -- -- /Since: 2/ showbAnyPrec :: Int -> Any -> Builder showbAnyPrec = showbPrec {-# INLINE showbAnyPrec #-} -- | Convert a 'Dual' value to a 'Builder' with the given show function and precedence. -- -- /Since: 2/ showbDualPrecWith :: (Int -> a -> Builder) -> Int -> Dual a -> Builder showbDualPrecWith = showbPrecWith {-# INLINE showbDualPrecWith #-} -- | Convert a 'First' value to a 'Builder' with the given show function and precedence. -- -- /Since: 2/ showbFirstPrecWith :: (Int -> a -> Builder) -> Int -> First a -> Builder showbFirstPrecWith = showbPrecWith {-# INLINE showbFirstPrecWith #-} -- | Convert a 'Last' value to a 'Builder' with the given show function and precedence. -- -- /Since: 2/ showbLastPrecWith :: (Int -> a -> Builder) -> Int -> Last a -> Builder showbLastPrecWith = showbPrecWith {-# INLINE showbLastPrecWith #-} -- | Convert a 'Product' value to a 'Builder' with the given show function -- and precedence. -- -- /Since: 2/ showbProductPrecWith :: (Int -> a -> Builder) -> Int -> Product a -> Builder showbProductPrecWith = showbPrecWith {-# INLINE showbProductPrecWith #-} -- | Convert a 'Sum' value to a 'Builder' with the given show function and precedence. -- -- /Since: 2/ showbSumPrecWith :: (Int -> a -> Builder) -> Int -> Sum a -> Builder showbSumPrecWith = showbPrecWith {-# INLINE showbSumPrecWith #-} #if MIN_VERSION_base(4,8,0) -- | Convert an 'Alt' value to a 'Builder' with the given precedence. -- This function is only available with @base-4.8.0.0@ or later. -- -- /Since: 2/ showbAltPrec :: TextShow (f a) => Int -> Alt f a -> Builder showbAltPrec = showbPrec {-# INLINE showbAltPrec #-} -- | Convert an 'Alt' value to a 'Builder' with the given show function and precedence. -- This function is only available with @base-4.8.0.0@ or later. -- -- /Since: 2/ showbAltPrecWith :: TextShow1 f => (Int -> a -> Builder) -> Int -> Alt f a -> Builder showbAltPrecWith = showbPrecWith #endif $(deriveTextShow ''All) $(deriveTextShow ''Any) $(deriveTextShow ''Dual) $(deriveTextShow1 ''Dual) $(deriveTextShow ''First) $(deriveTextShow1 ''First) $(deriveTextShow ''Last) $(deriveTextShow1 ''Last) $(deriveTextShow ''Product) $(deriveTextShow1 ''Product) $(deriveTextShow ''Sum) $(deriveTextShow1 ''Sum) #if MIN_VERSION_base(4,8,0) instance TextShow (f a) => TextShow (Alt f a) where showbPrec = $(makeShowbPrec ''Alt) $(deriveTextShow1 ''Alt) #endif text-show-2.1.1/src/TextShow/Data/Version.hs0000644000000000000000000000272112575552406017066 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Version Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' functions for 'Version'. /Since: 2/ -} module TextShow.Data.Version ( showbVersionPrec , showbVersionConcrete ) 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 (showb, showbPrec) import TextShow.Data.Char () import TextShow.Data.Integral () import TextShow.Data.List () import TextShow.TH.Internal (deriveTextShow) -- | Convert a 'Version' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbVersionPrec :: Int -> Version -> Builder showbVersionPrec = showbPrec {-# INLINE showbVersionPrec #-} -- | 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: 2/ showbVersionConcrete :: Version -> Builder showbVersionConcrete (Version branch tags) = mconcat (intersperse (singleton '.') $ map showb branch) <> mconcat (map ((singleton '-' <>) . fromString) tags) {-# INLINE showbVersionConcrete #-} $(deriveTextShow ''Version) text-show-2.1.1/src/TextShow/Data/ByteString.hs0000644000000000000000000001334112575552406017533 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-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' functions for data types in the @bytestring@ library. /Since: 2/ -} module TextShow.Data.ByteString ( showbByteStringStrict , showbByteStringLazy , showbByteStringLazyPrec , showbShortByteString ) 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 Data.Text.Lazy.Builder (Builder) import GHC.Exts (ByteArray#, Char(C#), Int(I#), indexCharArray#) import TextShow.Classes (TextShow(showb, showbPrec)) 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 #include "inline.h" -- | Convert a strict 'BS.ByteString' to a 'Builder'. -- -- /Since: 2/ {-# INLINE showbByteStringStrict #-} showbByteStringStrict :: BS.ByteString -> Builder #if MIN_VERSION_bytestring(0,10,0) showbByteStringStrict = showb . BS.unpackChars #else showbByteStringStrict = 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 -- | Convert a lazy 'BL.ByteString' to a 'Builder'. -- -- /Since: 2/ showbByteStringLazy :: BL.ByteString -> Builder showbByteStringLazy = showbByteStringLazyPrec 0 {-# INLINE showbByteStringLazy #-} -- | Convert a lazy 'BL.ByteString' to a 'Builder' with the given precedence. -- -- With @bytestring-0.10.0.0@ or later, this function ignores the precedence -- argument, since lazy 'BL.ByteString's are printed out identically to 'String's. -- On earlier versions of @bytestring@, however, lazy 'BL.ByteString's can be printed -- with parentheses (e.g., @Chunk "example" Empty@ vs. @(Chunk "example" Empty)@) -- depending on the precedence. -- -- /Since: 2/ showbByteStringLazyPrec :: Int -> BL.ByteString -> Builder #if MIN_VERSION_bytestring(0,10,0) showbByteStringLazyPrec _ = showb . BL.unpackChars #else showbByteStringLazyPrec = showbPrec #endif {-# INLINE showbByteStringLazyPrec #-} -- | Convert a 'ShortByteString' to a 'Builder'. -- -- /Since: 2/ showbShortByteString :: ShortByteString -> Builder showbShortByteString = showb . unpackChars {-# INLINE showbShortByteString #-} -- 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) ------------------------------------------------------------------------ -- 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# instance TextShow BS.ByteString where showb = showbByteStringStrict INLINE_INST_FUN(showb) #if MIN_VERSION_bytestring(0,10,0) instance TextShow BL.ByteString where showbPrec = showbByteStringLazyPrec INLINE_INST_FUN(showbPrec) #else $(deriveTextShow ''BL.ByteString) #endif instance TextShow ShortByteString where showb = showbShortByteString INLINE_INST_FUN(showb) text-show-2.1.1/src/TextShow/Data/Array.hs0000644000000000000000000000470612575552406016524 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Array Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' function for 'Array' values. /Since: 2/ -} module TextShow.Data.Array ( showbArrayPrec , showbUArrayPrec , 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(showb, showbPrec), showbParen, showbSpace) import TextShow.Data.List () import TextShow.Data.Tuple () #include "inline.h" -- | Convert an 'Array' value to a 'Builder' with the given precedence. -- -- /Since: 2/ showbArrayPrec :: (TextShow i, TextShow e, Ix i) => Int -> Array i e -> Builder showbArrayPrec p a = showbParen (p > appPrec) $ "array " <> showb (Array.bounds a) <> showbSpace <> showb (Array.assocs a) {-# INLINE showbArrayPrec #-} -- | Convert a 'UArray' value to a 'Builder' with the given precedence. -- -- /Since: 2/ showbUArrayPrec :: (IArray UArray e, Ix i, TextShow i, TextShow e) => Int -> UArray i e -> Builder showbUArrayPrec = showbIArrayPrec {-# INLINE showbUArrayPrec #-} {-# 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) instance (TextShow i, TextShow e, Ix i) => TextShow (Array i e) where showbPrec = showbArrayPrec INLINE_INST_FUN(showbPrec) instance (IArray UArray e, Ix i, TextShow i, TextShow e) => TextShow (UArray i e) where showbPrec = showbUArrayPrec INLINE_INST_FUN(showbPrec) text-show-2.1.1/src/TextShow/Data/Text.hs0000644000000000000000000001071612575552406016370 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-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' functions for 'Text' types. /Since: 2/ -} module TextShow.Data.Text ( showbText , showbTextLazy , showbBuilder , showbI16Prec , showbUnicodeException #if MIN_VERSION_text(1,0,0) , showbDecodingPrec #endif #if MIN_VERSION_text(1,1,0) , showbSizePrec #endif ) 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(showb, showbPrec)) 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 (showbByteStringStrict) #endif #if MIN_VERSION_text(1,1,0) import Data.Text.Internal.Fusion.Size (Size) #endif #include "inline.h" -- | Convert a strict 'TS.Text' to a 'Builder'. -- 'showbText' should not be confused with @fromText@, as 'showbText' escapes -- certain characters (such as double quotes). -- -- /Since: 2/ showbText :: TS.Text -> Builder showbText = showbString . TS.unpack {-# INLINE showbText #-} -- | Convert a lazy 'TL.Text' to a 'Builder'. -- 'showbTextLazy' should not be confused with @fromTextLazy@, as 'showbTextLazy' -- escapes certain characters (such as double quotes). -- -- /Since: 2/ showbTextLazy :: TL.Text -> Builder showbTextLazy = showbString . TL.unpack {-# INLINE showbTextLazy #-} -- | Show a 'Builder' as if it were a 'String' (i.e., escape certain characters, -- such as double quotes). -- -- /Since: 2/ showbBuilder :: Builder -> Builder showbBuilder = showbTextLazy . toLazyText {-# INLINE showbBuilder #-} -- | Convert an 'I16' value to a 'Builder' with the given precedence. -- -- /Since: 2/ showbI16Prec :: Int -> I16 -> Builder showbI16Prec = showbPrec {-# INLINE showbI16Prec #-} -- | Convert a 'UnicodeException' to a 'Builder'. -- -- /Since: 2/ showbUnicodeException :: UnicodeException -> Builder showbUnicodeException (DecodeError desc (Just w)) = "Cannot decode byte '\\x" <> showbHex w <> "': " <> fromString desc showbUnicodeException (DecodeError desc Nothing) = "Cannot decode input: " <> fromString desc showbUnicodeException (EncodeError desc (Just c)) = "Cannot encode character '\\x" <> showbHex (fromEnum c) <> "': " <> fromString desc showbUnicodeException (EncodeError desc Nothing) = "Cannot encode input: " <> fromString desc #if MIN_VERSION_text(1,0,0) -- | Convert a 'Decoding' value to a 'Builder' with the given precedence. -- This function is only available with @text-1.0.0.0@ or later. -- -- /Since: 2/ showbDecodingPrec :: Int -> Decoding -> Builder showbDecodingPrec p (Some t bs _) = showbParen (p > appPrec) $ fromString "Some " <> showbText t <> singleton ' ' <> showbByteStringStrict bs <> fromString " _" {-# INLINE showbDecodingPrec #-} #endif #if MIN_VERSION_text(1,1,0) -- | Convert a 'Size' value to a 'Builder' with the given precedence. -- This function is only available with @text-1.1.0.0@ or later. -- -- /Since: 2/ showbSizePrec :: Int -> Size -> Builder showbSizePrec = showbPrec {-# INLINE showbSizePrec #-} #endif instance TextShow TS.Text where showb = showbText INLINE_INST_FUN(showb) instance TextShow TL.Text where showb = showbTextLazy INLINE_INST_FUN(showb) instance TextShow Builder where showb = showbBuilder INLINE_INST_FUN(showb) $(deriveTextShow ''I16) instance TextShow UnicodeException where showb = showbUnicodeException INLINE_INST_FUN(showb) #if MIN_VERSION_text(1,0,0) instance TextShow Decoding where showbPrec = showbDecodingPrec INLINE_INST_FUN(showbPrec) #endif #if MIN_VERSION_text(1,1,0) $(deriveTextShow ''Size) #endif text-show-2.1.1/src/TextShow/Data/Bool.hs0000644000000000000000000000120112575552406016324 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Bool Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' function for 'Bool' values. /Since: 2/ -} module TextShow.Data.Bool (showbBool) where import Data.Text.Lazy.Builder (Builder) import TextShow.Classes (showb) import TextShow.TH.Internal (deriveTextShow) -- | Convert a 'Bool' to a 'Builder'. -- -- /Since: 2/ showbBool :: Bool -> Builder showbBool = showb {-# INLINE showbBool #-} $(deriveTextShow ''Bool) text-show-2.1.1/src/TextShow/Data/Ord.hs0000644000000000000000000000205112575552406016161 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Ord Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' functions for 'Ordering' and 'Down'. /Since: 2/ -} module TextShow.Data.Ord ( showbOrdering , showbDownPrecWith ) where import Data.Text.Lazy.Builder (Builder) import GHC.Exts (Down) import TextShow.Classes (showb, showbPrecWith) import TextShow.TH.Internal (deriveTextShow, deriveTextShow1) -- | Convert a 'Ordering' to a 'Builder'. -- -- /Since: 2/ showbOrdering :: Ordering -> Builder showbOrdering = showb {-# INLINE showbOrdering #-} -- | Convert a 'Down' value to a 'Builder' with the given show function and precedence. -- -- /Since: 2/ showbDownPrecWith :: (Int -> a -> Builder) -> Int -> Down a -> Builder showbDownPrecWith = showbPrecWith {-# INLINE showbDownPrecWith #-} $(deriveTextShow ''Ordering) $(deriveTextShow ''Down) $(deriveTextShow1 ''Down) text-show-2.1.1/src/TextShow/Data/Dynamic.hs0000644000000000000000000000165612575552406017033 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Dynamic Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' function for 'Dynamic'. /Since: 2/ -} module TextShow.Data.Dynamic (showbDynamic) where import Data.Dynamic (Dynamic, dynTypeRep) import Data.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (Builder) import Prelude () import TextShow.Classes (TextShow(showb)) import TextShow.Data.Typeable (showbTypeRepPrec) #include "inline.h" -- | Convert a 'Dynamic' value to a 'Builder'. -- -- /Since: 2/ showbDynamic :: Dynamic -> Builder showbDynamic dyn = "<<" <> showbTypeRepPrec 0 (dynTypeRep dyn) <> ">>" {-# INLINE showbDynamic #-} instance TextShow Dynamic where showb = showbDynamic INLINE_INST_FUN(showb) text-show-2.1.1/src/TextShow/Data/OldTypeable.hs0000644000000000000000000000463612575552406017654 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-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' functions for data types in the @OldTypeable@ module. This module only exports functions if using @base-4.7@. /Since: 2/ -} module TextShow.Data.OldTypeable ( #if !(MIN_VERSION_base(4,7,0)) || MIN_VERSION_base(4,8,0) ) where #else showbTyCon , showbTypeRepPrec ) where import Data.Monoid.Compat ((<>)) import Data.OldTypeable.Internal (TyCon(TyCon, tyConName), TypeRep(..), funTc, listTc) import Data.Text.Lazy.Builder (Builder, fromString, singleton) import TextShow.Classes (TextShow(showb, showbPrec), showbParen, showbSpace) import TextShow.Data.Typeable.Utils (showbArgs, showbTuple) import TextShow.Utils (isTupleString) -- | Convert a 'TyCon' to a 'Builder'. -- This function is only available with @base-4.7@. -- -- /Since: 2/ showbTyCon :: TyCon -> Builder showbTyCon = fromString . tyConName {-# INLINE showbTyCon #-} -- | Convert a 'TypeRep' to a 'Builder' with the given precedence. -- This function is only available with @base-4.7@. -- -- /Since: 2/ showbTypeRepPrec :: Int -> TypeRep -> Builder showbTypeRepPrec p (TypeRep _ tycon tys) = case tys of [] -> showbTyCon 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 -- | Does the 'TyCon' represent a tuple type constructor? isTupleTyCon :: TyCon -> Bool isTupleTyCon (TyCon _ _ _ str) = isTupleString str {-# INLINE isTupleTyCon #-} instance TextShow TyCon where showb = showbTyCon {-# INLINE showb #-} instance TextShow TypeRep where showbPrec = showbTypeRepPrec {-# INLINE showbPrec #-} #endif text-show-2.1.1/src/TextShow/Data/Fixed.hs0000644000000000000000000000522312575552406016500 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Fixed Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'Show' function for 'Fixed' values. /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(showb)) #if MIN_VERSION_base(4,7,0) import Data.Fixed (Fixed(..)) import Data.Int (Int64) import Data.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (singleton) import TextShow.Data.Integral () import TextShow.Utils (lengthB, mtimesDefault) #else import Data.Fixed (Fixed, showFixed) import Data.Text.Lazy.Builder (fromString) #endif #include "inline.h" -- | 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 instance HasResolution a => TextShow (Fixed a) where showb = showbFixed False INLINE_INST_FUN(showb) text-show-2.1.1/src/TextShow/Data/Tuple.hs0000644000000000000000000001730712575552406016540 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Tuple Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' functions for tuple types. /Since: 2/ -} module TextShow.Data.Tuple ( showbUnit , showb2TupleWith2 , showb3TupleWith2 , showb4TupleWith2 , showb5TupleWith2 , showb6TupleWith2 , showb7TupleWith2 , showb8TupleWith2 , showb9TupleWith2 , showb10TupleWith2 , showb11TupleWith2 , showb12TupleWith2 , showb13TupleWith2 , showb14TupleWith2 , showb15TupleWith2 ) where import Data.Text.Lazy.Builder (Builder) import TextShow.Classes (TextShow(showb), TextShow2(..)) import TextShow.TH.Internal (deriveTextShow, deriveTextShow1, deriveTextShow2) #include "inline.h" -- | Converts @()@ into a 'Builder'. -- -- /Since: 2/ showbUnit :: () -> Builder -- showbUnit () = "()" showbUnit = showb {-# INLINE showbUnit #-} -- | Converts a 2-tuple into a 'Builder' with the given show functions. -- -- /Since: 2/ showb2TupleWith2 :: (a -> Builder) -> (b -> Builder) -> (a, b) -> Builder showb2TupleWith2 = showbWith2 {-# INLINE showb2TupleWith2 #-} -- | Converts a 3-tuple into a 'Builder' with the given show functions. -- -- /Since: 2/ showb3TupleWith2 :: TextShow a => (b -> Builder) -> (c -> Builder) -> (a, b, c) -> Builder showb3TupleWith2 = showbWith2 {-# INLINE showb3TupleWith2 #-} -- | Converts a 4-tuple into a 'Builder' with the given show functions. -- -- /Since: 2/ showb4TupleWith2 :: (TextShow a, TextShow b) => (c -> Builder) -> (d -> Builder) -> (a, b, c, d) -> Builder showb4TupleWith2 = showbWith2 {-# INLINE showb4TupleWith2 #-} -- | Converts a 5-tuple into a 'Builder' with the given show functions. -- -- /Since: 2/ showb5TupleWith2 :: (TextShow a, TextShow b, TextShow c) => (d -> Builder) -> (e -> Builder) -> (a, b, c, d, e) -> Builder showb5TupleWith2 = showbWith2 {-# INLINE showb5TupleWith2 #-} -- | Converts a 6-tuple into a 'Builder' with the given show functions. -- -- /Since: 2/ showb6TupleWith2 :: (TextShow a, TextShow b, TextShow c, TextShow d) => (e -> Builder) -> (f -> Builder) -> (a, b, c, d, e, f) -> Builder showb6TupleWith2 = showbWith2 {-# INLINE showb6TupleWith2 #-} -- | Converts a 7-tuple into a 'Builder' with the given show functions. -- -- /Since: 2/ showb7TupleWith2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e) => (f -> Builder) -> (g -> Builder) -> (a, b, c, d, e, f, g) -> Builder showb7TupleWith2 = showbWith2 {-# INLINE showb7TupleWith2 #-} -- | Converts an 8-tuple into a 'Builder' with the given show functions. -- -- /Since: 2/ showb8TupleWith2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f) => (g -> Builder) -> (h -> Builder) -> (a, b, c, d, e, f, g, h) -> Builder showb8TupleWith2 = showbWith2 {-# INLINE showb8TupleWith2 #-} -- | Converts a 9-tuple into a 'Builder' with the given show functions. -- -- /Since: 2/ showb9TupleWith2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f, TextShow g) => (h -> Builder) -> (i -> Builder) -> (a, b, c, d, e, f, g, h, i) -> Builder showb9TupleWith2 = showbWith2 {-# INLINE showb9TupleWith2 #-} -- | Converts a 10-tuple into a 'Builder' with the given show functions. -- -- /Since: 2/ showb10TupleWith2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f, TextShow g, TextShow h) => (i -> Builder) -> (j -> Builder) -> (a, b, c, d, e, f, g, h, i, j) -> Builder showb10TupleWith2 = showbWith2 {-# INLINE showb10TupleWith2 #-} -- | Converts an 11-tuple into a 'Builder' with the given show functions. -- -- /Since: 2/ showb11TupleWith2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f, TextShow g, TextShow h, TextShow i) => (j -> Builder) -> (k -> Builder) -> (a, b, c, d, e, f, g, h, i, j, k) -> Builder showb11TupleWith2 = showbWith2 {-# INLINE showb11TupleWith2 #-} -- | Converts a 12-tuple into a 'Builder' with the given show functions. -- -- /Since: 2/ showb12TupleWith2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f, TextShow g, TextShow h, TextShow i, TextShow j) => (k -> Builder) -> (l -> Builder) -> (a, b, c, d, e, f, g, h, i, j, k, l) -> Builder showb12TupleWith2 = showbWith2 {-# INLINE showb12TupleWith2 #-} -- | Converts a 13-tuple into a 'Builder' with the given show functions. -- -- /Since: 2/ showb13TupleWith2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f, TextShow g, TextShow h, TextShow i, TextShow j, TextShow k) => (l -> Builder) -> (m -> Builder) -> (a, b, c, d, e, f, g, h, i, j, k, l, m) -> Builder showb13TupleWith2 = showbWith2 {-# INLINE showb13TupleWith2 #-} -- | Converts a 14-tuple into a 'Builder' with the given show functions. -- -- /Since: 2/ showb14TupleWith2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f, TextShow g, TextShow h, TextShow i, TextShow j, TextShow k, TextShow l) => (m -> Builder) -> (n -> Builder) -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -> Builder showb14TupleWith2 = showbWith2 {-# INLINE showb14TupleWith2 #-} -- | Converts a 15-tuple into a 'Builder' with the given show functions. -- -- /Since: 2/ showb15TupleWith2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f, TextShow g, TextShow h, TextShow i, TextShow j, TextShow k, TextShow l, TextShow m) => (n -> Builder) -> (o -> Builder) -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -> Builder showb15TupleWith2 = showbWith2 {-# INLINE showb15TupleWith2 #-} -- | Like 'showbPrecWith2', except precedence-agnostic. showbWith2 :: TextShow2 f => (a -> Builder) -> (b -> Builder) -> f a b -> Builder showbWith2 sp1 sp2 = showbPrecWith2 (const sp1) (const sp2) 0 {-# INLINE showbWith2 #-} -- The Great Pyramids of Template Haskell $(deriveTextShow ''()) $(deriveTextShow ''(,)) $(deriveTextShow ''(,,)) $(deriveTextShow ''(,,,)) $(deriveTextShow ''(,,,,)) $(deriveTextShow ''(,,,,,)) $(deriveTextShow ''(,,,,,,)) $(deriveTextShow ''(,,,,,,,)) $(deriveTextShow ''(,,,,,,,,)) $(deriveTextShow ''(,,,,,,,,,)) $(deriveTextShow ''(,,,,,,,,,,)) $(deriveTextShow ''(,,,,,,,,,,,)) $(deriveTextShow ''(,,,,,,,,,,,,)) $(deriveTextShow ''(,,,,,,,,,,,,,)) $(deriveTextShow ''(,,,,,,,,,,,,,,)) $(deriveTextShow1 ''(,)) $(deriveTextShow1 ''(,,)) $(deriveTextShow1 ''(,,,)) $(deriveTextShow1 ''(,,,,)) $(deriveTextShow1 ''(,,,,,)) $(deriveTextShow1 ''(,,,,,,)) $(deriveTextShow1 ''(,,,,,,,)) $(deriveTextShow1 ''(,,,,,,,,)) $(deriveTextShow1 ''(,,,,,,,,,)) $(deriveTextShow1 ''(,,,,,,,,,,)) $(deriveTextShow1 ''(,,,,,,,,,,,)) $(deriveTextShow1 ''(,,,,,,,,,,,,)) $(deriveTextShow1 ''(,,,,,,,,,,,,,)) $(deriveTextShow1 ''(,,,,,,,,,,,,,,)) $(deriveTextShow2 ''(,)) $(deriveTextShow2 ''(,,)) $(deriveTextShow2 ''(,,,)) $(deriveTextShow2 ''(,,,,)) $(deriveTextShow2 ''(,,,,,)) $(deriveTextShow2 ''(,,,,,,)) $(deriveTextShow2 ''(,,,,,,,)) $(deriveTextShow2 ''(,,,,,,,,)) $(deriveTextShow2 ''(,,,,,,,,,)) $(deriveTextShow2 ''(,,,,,,,,,,)) $(deriveTextShow2 ''(,,,,,,,,,,,)) $(deriveTextShow2 ''(,,,,,,,,,,,,)) $(deriveTextShow2 ''(,,,,,,,,,,,,,)) $(deriveTextShow2 ''(,,,,,,,,,,,,,,)) text-show-2.1.1/src/TextShow/Data/Char.hs0000644000000000000000000000670212575552406016321 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Char Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' 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 (showbIntPrec) import TextShow.TH.Internal (deriveTextShow) #include "inline.h" -- | 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 '\\' <> showbIntPrec 0 (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 '\\' <> showbIntPrec 0 (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 #-} instance TextShow Char where showb = showbChar INLINE_INST_FUN(showb) showbList = showbString INLINE_INST_FUN(showbList) $(deriveTextShow ''GeneralCategory) text-show-2.1.1/src/TextShow/Data/Typeable.hs0000644000000000000000000000575112575552406017214 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Typeable Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' functions for data types in the @Typeable@ module. /Since: 2/ -} module TextShow.Data.Typeable (showbTyCon, showbTypeRepPrec) where import Data.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (Builder, fromString, singleton) import Data.Typeable (TypeRep, typeRepArgs, typeRepTyCon) #if MIN_VERSION_base(4,4,0) import Data.Typeable.Internal (TyCon(..), funTc, listTc) # if MIN_VERSION_base(4,8,0) import Data.Typeable.Internal (typeRepKinds) # endif #else import Data.Typeable (TyCon, mkTyCon, tyConString, typeOf) #endif import TextShow.Classes (TextShow(showb, showbPrec), showbParen, showbSpace) import TextShow.Data.List () import TextShow.Data.Typeable.Utils (showbArgs, showbTuple) import TextShow.Utils (isTupleString) #include "inline.h" -- | Convert a 'TypeRep' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbTypeRepPrec :: Int -> TypeRep -> Builder showbTypeRepPrec p tyrep = case tys of [] -> showbTyCon 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 #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 #if !(MIN_VERSION_base(4,4,0)) -- | The list 'TyCon'. listTc :: TyCon listTc = typeRepTyCon $ typeOf [()] -- | The function (@->@) 'TyCon'. funTc :: TyCon funTc = mkTyCon "->" #endif -- | Does the 'TyCon' represent a tuple type constructor? isTupleTyCon :: TyCon -> Bool isTupleTyCon = isTupleString . tyConString {-# INLINE isTupleTyCon #-} -- | Convert a 'TyCon' to a 'Builder'. -- -- /Since: 2/ showbTyCon :: TyCon -> Builder showbTyCon = fromString . tyConString {-# INLINE showbTyCon #-} #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 instance TextShow TypeRep where showbPrec = showbTypeRepPrec INLINE_INST_FUN(showbPrec) instance TextShow TyCon where showb = showbTyCon INLINE_INST_FUN(showb) text-show-2.1.1/src/TextShow/Data/Data.hs0000644000000000000000000000360612575552406016315 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Data Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' functions for data types in the @Data.Data@ module. /Since: 2/ -} module TextShow.Data.Data ( showbConstr , showbConstrRepPrec , showbDataRepPrec , showbDataTypePrec , showbFixity ) where import Data.Data (Constr, ConstrRep, DataRep, DataType, Fixity, showConstr) import Data.Text.Lazy.Builder (Builder, fromString) import TextShow.Classes (TextShow(showb, showbPrec)) import TextShow.Data.List () import TextShow.Data.Ratio () import TextShow.TH.Internal (deriveTextShow) #include "inline.h" -- | Convert a 'DataType' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbDataTypePrec :: Int -> DataType -> Builder showbDataTypePrec = showbPrec {-# INLINE showbDataTypePrec #-} -- | Convert a 'DataRep' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbDataRepPrec :: Int -> DataRep -> Builder showbDataRepPrec = showbPrec {-# INLINE showbDataRepPrec #-} -- | Convert a 'Constr' to a 'Builder'. -- -- /Since: 2/ showbConstr :: Constr -> Builder showbConstr = fromString . showConstr {-# INLINE showbConstr #-} -- | Convert a 'Fixity' value to a 'Builder'. -- -- /Since: 2/ showbFixity :: Fixity -> Builder showbFixity = showb {-# INLINE showbFixity #-} -- | Convert a 'ConstrRep' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbConstrRepPrec :: Int -> ConstrRep -> Builder showbConstrRepPrec = showbPrec {-# INLINE showbConstrRepPrec #-} $(deriveTextShow ''DataType) $(deriveTextShow ''DataRep) $(deriveTextShow ''ConstrRep) $(deriveTextShow ''Fixity) instance TextShow Constr where showb = showbConstr INLINE_INST_FUN(showb) text-show-2.1.1/src/TextShow/Data/Integral.hs0000644000000000000000000001445112575552406017211 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Integral Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' functions for integral types. /Since: 2/ -} module TextShow.Data.Integral ( showbIntPrec , showbInt8Prec , showbInt16Prec , showbInt32Prec , showbInt64Prec , showbIntegerPrec , showbIntegralPrec , showbIntAtBase , showbBin , showbHex , showbOct , showbWord , showbWord8 , showbWord16 , showbWord32 , showbWord64 ) 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(showb, showbPrec)) import TextShow.Utils (toString) #include "inline.h" -- | Convert an 'Int' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbIntPrec :: Int -> Int -> Builder showbIntPrec (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 -- | Convert an 'Int8' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbInt8Prec :: Int -> Int8 -> Builder showbInt8Prec p = showbIntPrec p . fromIntegral {-# INLINE showbInt8Prec #-} -- | Convert an 'Int16' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbInt16Prec :: Int -> Int16 -> Builder showbInt16Prec p = showbIntPrec p . fromIntegral {-# INLINE showbInt16Prec #-} -- | Convert an 'Int32' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbInt32Prec :: Int -> Int32 -> Builder showbInt32Prec p = showbIntPrec p . fromIntegral {-# INLINE showbInt32Prec #-} -- | Convert an 'Int64' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbInt64Prec :: Int -> Int64 -> Builder #if WORD_SIZE_IN_BITS < 64 showbInt64Prec p = showbIntegerPrec p . toInteger #else showbInt64Prec p = showbIntPrec p . fromIntegral #endif {-# INLINE showbInt64Prec #-} -- | Convert an 'Integer' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbIntegerPrec :: Int -> Integer -> Builder showbIntegerPrec p n | p > 6 && n < 0 = singleton '(' <> decimal n <> singleton ')' | otherwise = decimal n {-# INLINE showbIntegerPrec #-} -- | Convert an 'Integral' type to a 'Builder' with the given precedence. -- -- /Since: 2/ showbIntegralPrec :: Integral a => Int -> a -> Builder showbIntegralPrec p = showbIntegerPrec 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 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 #-} -- | Convert a 'Word' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbWord :: Word -> Builder showbWord = decimal {-# INLINE showbWord #-} -- | Convert a 'Word8' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbWord8 :: Word8 -> Builder showbWord8 = decimal {-# INLINE showbWord8 #-} -- | Convert a 'Word16' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbWord16 :: Word16 -> Builder showbWord16 = decimal {-# INLINE showbWord16 #-} -- | Convert a 'Word32' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbWord32 :: Word32 -> Builder showbWord32 = decimal {-# INLINE showbWord32 #-} -- | Convert a 'Word64' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbWord64 :: Word64 -> Builder showbWord64 = decimal {-# INLINE showbWord64 #-} instance TextShow Int where showbPrec = showbIntPrec INLINE_INST_FUN(showbPrec) instance TextShow Int8 where showbPrec = showbInt8Prec INLINE_INST_FUN(showbPrec) instance TextShow Int16 where showbPrec = showbInt16Prec INLINE_INST_FUN(showbPrec) instance TextShow Int32 where showbPrec = showbInt32Prec INLINE_INST_FUN(showbPrec) instance TextShow Int64 where showbPrec = showbInt64Prec INLINE_INST_FUN(showbPrec) instance TextShow Integer where showbPrec = showbIntegerPrec INLINE_INST_FUN(showbPrec) instance TextShow Word where showb = showbWord INLINE_INST_FUN(showb) instance TextShow Word8 where showb = showbWord8 INLINE_INST_FUN(showb) instance TextShow Word16 where showb = showbWord16 INLINE_INST_FUN(showb) instance TextShow Word32 where showb = showbWord32 INLINE_INST_FUN(showb) instance TextShow Word64 where showb = showbWord64 INLINE_INST_FUN(showb) text-show-2.1.1/src/TextShow/Data/Proxy.hs0000644000000000000000000000175212575552406016565 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-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' function for 'Proxy' values. /Since: 2/ -} module TextShow.Data.Proxy (showbProxy) where import Data.Proxy (Proxy(..)) import Data.Text.Lazy.Builder (Builder) import TextShow.Classes (TextShow(showb, showbPrec)) import TextShow.TH.Internal (deriveTextShow1, makeShowbPrec) #include "inline.h" -- | Convert a 'Proxy' type to a 'Builder'. -- -- /Since: 2/ showbProxy :: Proxy s -> Builder showbProxy = showb {-# INLINE showbProxy #-} instance TextShow (Proxy s) where showbPrec = $(makeShowbPrec ''Proxy) INLINE_INST_FUN(showbPrec) $(deriveTextShow1 ''Proxy) text-show-2.1.1/src/TextShow/Data/Ratio.hs0000644000000000000000000000342112575552406016515 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Ratio Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' function for 'Ratio' values. /Since: 2/ -} module TextShow.Data.Ratio (showbRatioPrec) where import Data.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (Builder) import GHC.Real (Ratio(..), ratioPrec, ratioPrec1) import TextShow.Classes (TextShow(showbPrec), showbParen) #if MIN_VERSION_base(4,4,0) import TextShow.Classes (TextShow1(..)) #endif import TextShow.Data.Integral () #include "inline.h" -- | Convert a 'Ratio' to a 'Builder' with the given precedence. -- -- Note that on @base-4.3.0.0@, this function must have a @('Show' a, 'Integral' a)@ -- constraint instead of just a @('Show' a)@ constraint. -- -- /Since: 2/ showbRatioPrec :: #if MIN_VERSION_base(4,4,0) TextShow a #else (TextShow a, Integral a) #endif => Int -> Ratio a -> Builder showbRatioPrec p (numer :% denom) = showbParen (p > ratioPrec) $ showbPrec ratioPrec1 numer <> " % " <> showbPrec ratioPrec1 denom {-# INLINE showbRatioPrec #-} 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 = showbRatioPrec INLINE_INST_FUN(showbPrec) #if MIN_VERSION_base(4,4,0) instance TextShow1 Ratio where showbPrecWith sp p (numer :% denom) = showbParen (p > ratioPrec) $ sp ratioPrec1 numer <> " % " <> sp ratioPrec1 denom INLINE_INST_FUN(showbPrecWith) #endif text-show-2.1.1/src/TextShow/Data/Complex.hs0000644000000000000000000000325012575552406017046 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Ratio Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' function for 'Ratio' values. 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 (showbComplexPrec) where import Data.Complex (Complex) import Data.Text.Lazy.Builder (Builder) import TextShow.Classes (TextShow(showbPrec)) import TextShow.Data.Floating () import TextShow.TH.Internal (makeShowbPrec) #if MIN_VERSION_base(4,4,0) import TextShow.TH.Internal (deriveTextShow1) #endif #include "inline.h" -- | Convert a 'Complex' value to a 'Builder' with the given precedence. -- -- Note that on @base-4.3.0.0@, this function must have a @('TextShow' a, -- 'RealFloat' a)@ constraint instead of just a @('TextShow' a)@ constraint. -- -- /Since: 2/ #if MIN_VERSION_base(4,4,0) showbComplexPrec :: TextShow a #else showbComplexPrec :: (RealFloat a, TextShow a) #endif => Int -> Complex a -> Builder showbComplexPrec = showbPrec {-# INLINE showbComplexPrec #-} 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_INST_FUN(showbPrec) #if MIN_VERSION_base(4,4,0) $(deriveTextShow1 ''Complex) #endif text-show-2.1.1/src/TextShow/Data/Floating.hs0000644000000000000000000003311012575552406017200 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Floating Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' functions for floating-point types. /Since: 2/ -} module TextShow.Data.Floating ( showbRealFloatPrec , showbFloatPrec , showbDoublePrec , 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(showb, showbPrec), showbParen) import TextShow.TH.Internal (deriveTextShow) import TextShow.Utils (i2d) #include "inline.h" -- | 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 #-} -- | Convert a 'Float' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbFloatPrec :: Int -> Float -> Builder showbFloatPrec = showbRealFloatPrec {-# INLINE showbFloatPrec #-} -- | Convert a 'Double' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbDoublePrec :: Int -> Double -> Builder showbDoublePrec = showbRealFloatPrec {-# INLINE showbDoublePrec #-} -- | 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 {-# INLINE showbEFloat #-} -- | 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 {-# INLINE showbFFloat #-} -- | 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 {-# INLINE showbGFloat #-} -- | 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 ------------------------------------------------------------------------------- instance TextShow Float where showbPrec = showbFloatPrec INLINE_INST_FUN(showbPrec) instance TextShow Double where showbPrec = showbDoublePrec INLINE_INST_FUN(showbPrec) $(deriveTextShow ''FPFormat) text-show-2.1.1/src/TextShow/Data/List.hs0000644000000000000000000000151112575552406016350 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.List Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Exports 'showbListWith'. -} module TextShow.Data.List (showbListWith) where import TextShow.Classes (TextShow(showb, showbList), TextShow1(..), showbListWith) import TextShow.Data.Char () import TextShow.Data.Integral () #include "inline.h" instance TextShow a => TextShow [a] where {-# SPECIALIZE instance TextShow [String] #-} {-# SPECIALIZE instance TextShow String #-} {-# SPECIALIZE instance TextShow [Int] #-} showb = showbList INLINE_INST_FUN(showb) instance TextShow1 [] where showbPrecWith sp _ = showbListWith (sp 0) INLINE_INST_FUN(showbPrecWith) text-show-2.1.1/src/TextShow/Data/Either.hs0000644000000000000000000000174412575552406016665 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Either Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' function for 'Either' values. /Since: 2/ -} module TextShow.Data.Either (showbEitherPrecWith2) where import Data.Text.Lazy.Builder (Builder) import TextShow.Classes (showbPrecWith2) import TextShow.TH.Internal (deriveTextShow, deriveTextShow1, deriveTextShow2) #include "inline.h" -- | Convert a 'Either' value to a 'Builder' with the given show functions -- and precedence. -- -- /Since: 2/ showbEitherPrecWith2 :: (Int -> a -> Builder) -> (Int -> b -> Builder) -> Int -> Either a b -> Builder showbEitherPrecWith2 = showbPrecWith2 {-# INLINE showbEitherPrecWith2 #-} $(deriveTextShow ''Either) $(deriveTextShow1 ''Either) $(deriveTextShow2 ''Either) text-show-2.1.1/src/TextShow/Data/Typeable/0000755000000000000000000000000012575552406016650 5ustar0000000000000000text-show-2.1.1/src/TextShow/Data/Typeable/Utils.hs0000644000000000000000000000201112575552406020276 0ustar0000000000000000{-| Module: TextShow.Data.Typeable.Utils Copyright: (C) 2014-2015 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(showbPrec)) -- | 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-2.1.1/src/TextShow/Data/Functor/0000755000000000000000000000000012575552406016523 5ustar0000000000000000text-show-2.1.1/src/TextShow/Data/Functor/Identity.hs0000644000000000000000000000242512575552406020653 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Functor.Identity Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' function for 'Identity' values. /Since: 2/ -} module TextShow.Data.Functor.Identity (showbIdentityPrecWith) where import Data.Functor.Identity (Identity(..)) import Data.Text.Lazy.Builder (Builder) import TextShow.Classes (TextShow(showbPrec), TextShow1(..), showbPrec1, showbUnaryWith) #include "inline.h" -- | Convert an 'Identity' value to a 'Builder' with the given show function -- and precedence. -- -- /Since: 2/ showbIdentityPrecWith :: (Int -> a -> Builder) -> Int -> Identity a -> Builder -- This would be equivalent to the derived instance of 'Identity' if the -- 'runIdentity' field were removed. showbIdentityPrecWith sp p (Identity x) = showbUnaryWith sp "Identity" p x {-# INLINE showbIdentityPrecWith #-} instance TextShow a => TextShow (Identity a) where showbPrec = showbPrec1 {-# INLINE showbPrec #-} instance TextShow1 Identity where showbPrecWith = showbIdentityPrecWith INLINE_INST_FUN(showbPrecWith) text-show-2.1.1/src/TextShow/Data/Type/0000755000000000000000000000000012575552406016024 5ustar0000000000000000text-show-2.1.1/src/TextShow/Data/Type/Coercion.hs0000644000000000000000000000260312575552406020122 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-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' function for representational equality. This module only exports functions if using @base-4.7.0.0@ or later. /Since: 2/ -} module TextShow.Data.Type.Coercion ( #if !(MIN_VERSION_base(4,7,0)) ) where #else showbCoercion ) where import Data.Text.Lazy.Builder (Builder) import Data.Type.Coercion (Coercion(..)) import TextShow.Classes (TextShow(showb, showbPrec), TextShow1(..)) import TextShow.TH.Internal (deriveTextShow2, makeShowbPrec, makeShowbPrecWith) -- | Convert a representational equality value to a 'Builder'. -- This function is only available with @base-4.7.0.0@ or later. -- -- /Since: 2/ showbCoercion :: Coercion a b -> Builder showbCoercion = showb {-# INLINE showbCoercion #-} instance TextShow (Coercion a b) where showbPrec = $(makeShowbPrec ''Coercion) {-# INLINE showbPrec #-} instance TextShow1 (Coercion a) where showbPrecWith = $(makeShowbPrecWith ''Coercion) {-# INLINE showbPrecWith #-} $(deriveTextShow2 ''Coercion) #endif text-show-2.1.1/src/TextShow/Data/Type/Equality.hs0000644000000000000000000000262712575552406020164 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-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' function for propositional equality. This module only exports functions if using @base-4.7.0.0@ or later. /Since: 2/ -} module TextShow.Data.Type.Equality ( #if !(MIN_VERSION_base(4,7,0)) ) where #else showbPropEquality ) where import Data.Text.Lazy.Builder (Builder) import Data.Type.Equality ((:~:)(..)) import TextShow.Classes (TextShow(showb, showbPrec), TextShow1(..)) import TextShow.TH.Internal (deriveTextShow2, makeShowbPrec, makeShowbPrecWith) -- | Convert a propositional equality value to a 'Builder'. -- This function is only available with @base-4.7.0.0@ or later. -- -- /Since: 2/ showbPropEquality :: (a :~: b) -> Builder showbPropEquality = showb {-# INLINE showbPropEquality #-} instance TextShow (a :~: b) where showbPrec = $(makeShowbPrec ''(:~:)) {-# INLINE showbPrec #-} instance TextShow1 ((:~:) a) where showbPrecWith = $(makeShowbPrecWith ''(:~:)) {-# INLINE showbPrecWith #-} $(deriveTextShow2 ''(:~:)) #endif text-show-2.1.1/src/TextShow/System/0000755000000000000000000000000012575552406015516 5ustar0000000000000000text-show-2.1.1/src/TextShow/System/IO.hs0000644000000000000000000001006212575552406016360 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.System.IO Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' function for 'IO'-related data types. /Since: 2/ -} module TextShow.System.IO ( showbHandle , showbIOMode , showbBufferModePrec , showbHandlePosn , showbSeekMode , showbTextEncoding #if MIN_VERSION_base(4,4,0) , showbCodingProgress , showbCodingFailureMode #endif , showbNewline , showbNewlineModePrec ) 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(showb, showbPrec)) import TextShow.Data.Integral (showbIntegerPrec) import TextShow.Data.Maybe () import TextShow.TH.Internal (deriveTextShow) #include "inline.h" -- | Convert a 'Handle' to a 'Builder'. -- -- /Since: 2/ showbHandle :: Handle -> Builder showbHandle (FileHandle file _) = showbHandleFilePath file showbHandle (DuplexHandle file _ _) = showbHandleFilePath file {-# INLINE showbHandle #-} -- | Convert a 'Handle`'s 'FilePath' to a 'Builder'. showbHandleFilePath :: FilePath -> Builder showbHandleFilePath file = "{handle: " <> fromString file <> singleton '}' {-# INLINE showbHandleFilePath #-} -- | Convert an 'IOMode' to a 'Builder'. -- -- /Since: 2/ showbIOMode :: IOMode -> Builder showbIOMode = showb {-# INLINE showbIOMode #-} -- | Convert a 'BufferMode' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbBufferModePrec :: Int -> BufferMode -> Builder showbBufferModePrec = showbPrec {-# INLINE showbBufferModePrec #-} -- | Convert a 'HandlePosn' to a 'Builder'. -- -- /Since: 2/ showbHandlePosn :: HandlePosn -> Builder showbHandlePosn (HandlePosn h pos) = showbHandle h <> " at position " <> showbIntegerPrec 0 pos {-# INLINE showbHandlePosn #-} -- | Convert a 'SeekMode' to a 'Builder'. -- -- /Since: 2/ showbSeekMode :: SeekMode -> Builder showbSeekMode = showb {-# INLINE showbSeekMode #-} -- | Convert a 'TextEncoding' to a 'Builder'. -- -- /Since: 2/ showbTextEncoding :: TextEncoding -> Builder showbTextEncoding = fromString . textEncodingName {-# INLINE showbTextEncoding #-} #if MIN_VERSION_base(4,4,0) -- | Convert a 'CodingProgress' to a 'Builder'. -- This function is only available with @base-4.4.0.0@ or later. -- -- /Since: 2/ showbCodingProgress :: CodingProgress -> Builder showbCodingProgress = showb {-# INLINE showbCodingProgress #-} -- | Convert a 'CodingFailureMode' value to a 'Builder'. -- This function is only available with @base-4.4.0.0@ or later. -- -- /Since: 2/ showbCodingFailureMode :: CodingFailureMode -> Builder showbCodingFailureMode = showb {-# INLINE showbCodingFailureMode #-} #endif -- | Convert a 'Newline' to a 'Builder'. -- -- /Since: 2/ showbNewline :: Newline -> Builder showbNewline = showb {-# INLINE showbNewline #-} -- | Convert a 'NewlineMode' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbNewlineModePrec :: Int -> NewlineMode -> Builder showbNewlineModePrec = showbPrec {-# INLINE showbNewlineModePrec #-} instance TextShow Handle where showb = showbHandle INLINE_INST_FUN(showb) $(deriveTextShow ''IOMode) $(deriveTextShow ''BufferMode) instance TextShow HandlePosn where showb = showbHandlePosn INLINE_INST_FUN(showb) $(deriveTextShow ''SeekMode) instance TextShow TextEncoding where showb = showbTextEncoding INLINE_INST_FUN(showb) #if MIN_VERSION_base(4,4,0) $(deriveTextShow ''CodingProgress) $(deriveTextShow ''CodingFailureMode) #endif $(deriveTextShow ''Newline) $(deriveTextShow ''NewlineMode) text-show-2.1.1/src/TextShow/System/Exit.hs0000644000000000000000000000143012575552406016761 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.System.Exit Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' function for 'ExitCode'. /Since: 2/ -} module TextShow.System.Exit (showbExitCodePrec) where import Data.Text.Lazy.Builder (Builder) import System.Exit (ExitCode) import TextShow.Classes (showbPrec) import TextShow.Data.Integral () import TextShow.TH.Internal (deriveTextShow) -- | Convert an 'ExitCode' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbExitCodePrec :: Int -> ExitCode -> Builder showbExitCodePrec = showbPrec {-# INLINE showbExitCodePrec #-} $(deriveTextShow ''ExitCode) text-show-2.1.1/src/TextShow/System/Posix/0000755000000000000000000000000012575552406016620 5ustar0000000000000000text-show-2.1.1/src/TextShow/System/Posix/Types.hs0000644000000000000000000001763012575552406020267 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.System.Posix.Types Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' functions for Haskell equivalents of POSIX data types. Note that these functions are only available if the operating system supports them, so some OSes (e.g., Windows) will not be able to use all of the functions in this module. /Since: 2/ -} #include "HsBaseConfig.h" module TextShow.System.Posix.Types ( showbFdPrec #if defined(HTYPE_DEV_T) , showbCDev #endif #if defined(HTYPE_INO_T) , showbCIno #endif #if defined(HTYPE_MODE_T) , showbCMode #endif #if defined(HTYPE_OFF_T) , showbCOffPrec #endif #if defined(HTYPE_PID_T) , showbCPidPrec #endif #if defined(HTYPE_SSIZE_T) , showbCSsizePrec #endif #if defined(HTYPE_GID_T) , showbCGid #endif #if defined(HTYPE_NLINK_T) , showbCNlink #endif #if defined(HTYPE_UID_T) , showbCUid #endif #if defined(HTYPE_CC_T) , showbCCc #endif #if defined(HTYPE_SPEED_T) , showbCSpeed #endif #if defined(HTYPE_TCFLAG_T) , showbCTcflag #endif #if defined(HTYPE_RLIM_T) , showbCRLim #endif ) where import Data.Text.Lazy.Builder (Builder) import System.Posix.Types import TextShow.Classes (TextShow(showb, showbPrec)) import TextShow.Data.Integral () import TextShow.Foreign.C.Types () #if !(MIN_VERSION_base(4,5,0)) import Data.Int import Data.Word import Unsafe.Coerce (unsafeCoerce) # include "HsBaseConfig.h" # include "inline.h" #endif #if defined(HTYPE_DEV_T) -- | Convert a 'CDev' to a 'Builder'. -- -- /Since: 2/ showbCDev :: CDev -> Builder # if MIN_VERSION_base(4,5,0) showbCDev = showb {-# INLINE showbCDev #-} # else showbCDev = unsafeCoerce (showb :: HTYPE_DEV_T -> Builder) # endif #endif #if defined(HTYPE_INO_T) -- | Convert a 'CIno' to a 'Builder'. -- -- /Since: 2/ showbCIno :: CIno -> Builder # if MIN_VERSION_base(4,5,0) showbCIno = showb {-# INLINE showbCIno #-} # else showbCIno = unsafeCoerce (showb :: HTYPE_INO_T -> Builder) # endif #endif #if defined(HTYPE_MODE_T) -- | Convert a 'CMode' to a 'Builder'. -- -- /Since: 2/ showbCMode :: CMode -> Builder # if MIN_VERSION_base(4,5,0) showbCMode = showb {-# INLINE showbCMode #-} # else showbCMode = unsafeCoerce (showb :: HTYPE_MODE_T -> Builder) # endif #endif #if defined(HTYPE_OFF_T) -- | Convert a 'COff' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbCOffPrec :: Int -> COff -> Builder # if MIN_VERSION_base(4,5,0) showbCOffPrec = showbPrec {-# INLINE showbCOffPrec #-} # else showbCOffPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_OFF_T -> Builder) # endif #endif #if defined(HTYPE_PID_T) -- | Convert a 'CPid' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbCPidPrec :: Int -> CPid -> Builder # if MIN_VERSION_base(4,5,0) showbCPidPrec = showbPrec {-# INLINE showbCPidPrec #-} # else showbCPidPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_PID_T -> Builder) # endif #endif #if defined(HTYPE_SSIZE_T) -- | Convert a 'CSsize' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbCSsizePrec :: Int -> CSsize -> Builder # if MIN_VERSION_base(4,5,0) showbCSsizePrec = showbPrec {-# INLINE showbCSsizePrec #-} # else showbCSsizePrec = unsafeCoerce (showbPrec :: Int -> HTYPE_SSIZE_T -> Builder) # endif #endif #if defined(HTYPE_GID_T) -- | Convert a 'CGid' to a 'Builder'. -- -- /Since: 2/ showbCGid :: CGid -> Builder # if MIN_VERSION_base(4,5,0) showbCGid = showb {-# INLINE showbCGid #-} # else showbCGid = unsafeCoerce (showb :: HTYPE_GID_T -> Builder) # endif #endif #if defined(HTYPE_NLINK_T) -- | Convert a 'CNlink' to a 'Builder'. -- -- /Since: 2/ showbCNlink :: CNlink -> Builder # if MIN_VERSION_base(4,5,0) showbCNlink = showb {-# INLINE showbCNlink #-} # else showbCNlink = unsafeCoerce (showb :: HTYPE_NLINK_T -> Builder) # endif #endif #if defined(HTYPE_UID_T) -- | Convert a 'CUid' to a 'Builder'. -- -- /Since: 2/ showbCUid :: CUid -> Builder # if MIN_VERSION_base(4,5,0) showbCUid = showb {-# INLINE showbCUid #-} # else showbCUid = unsafeCoerce (showb :: HTYPE_UID_T -> Builder) # endif #endif #if defined(HTYPE_CC_T) -- | Convert a 'CCc' to a 'Builder'. -- -- /Since: 2/ showbCCc :: CCc -> Builder # if MIN_VERSION_base(4,5,0) showbCCc = showb {-# INLINE showbCCc #-} # else showbCCc = unsafeCoerce (showb :: HTYPE_CC_T -> Builder) # endif #endif #if defined(HTYPE_SPEED_T) -- | Convert a 'CSpeed' to a 'Builder'. -- -- /Since: 2/ showbCSpeed :: CSpeed -> Builder # if MIN_VERSION_base(4,5,0) showbCSpeed = showb {-# INLINE showbCSpeed #-} # else showbCSpeed = unsafeCoerce (showb :: HTYPE_SPEED_T -> Builder) # endif #endif #if defined(HTYPE_TCFLAG_T) -- | Convert a 'CTcflag' to a 'Builder'. -- -- /Since: 2/ showbCTcflag :: CTcflag -> Builder # if MIN_VERSION_base(4,5,0) showbCTcflag = showb {-# INLINE showbCTcflag #-} # else showbCTcflag = unsafeCoerce (showb :: HTYPE_TCFLAG_T -> Builder) # endif #endif #if defined(HTYPE_RLIM_T) -- | Convert a 'CRLim' to a 'Builder'. -- -- /Since: 2/ showbCRLim :: CRLim -> Builder # if MIN_VERSION_base(4,5,0) showbCRLim = showb {-# INLINE showbCRLim #-} # else showbCRLim = unsafeCoerce (showb :: HTYPE_RLIM_T -> Builder) # endif #endif -- | Convert an 'Fd' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbFdPrec :: Int -> Fd -> Builder showbFdPrec = showbPrec {-# INLINE showbFdPrec #-} #if MIN_VERSION_base(4,5,0) # if defined(HTYPE_DEV_T) deriving instance TextShow CDev # endif # if defined(HTYPE_INO_T) deriving instance TextShow CIno # endif # if defined(HTYPE_MODE_T) deriving instance TextShow CMode # endif # if defined(HTYPE_OFF_T) deriving instance TextShow COff # endif # if defined(HTYPE_PID_T) deriving instance TextShow CPid # endif # if defined(HTYPE_SSIZE_T) deriving instance TextShow CSsize # endif # if defined(HTYPE_GID_T) deriving instance TextShow CGid # endif # if defined(HTYPE_NLINK_T) deriving instance TextShow CNlink # endif # if defined(HTYPE_UID_T) deriving instance TextShow CUid # endif # if defined(HTYPE_CC_T) deriving instance TextShow CCc # endif # if defined(HTYPE_SPEED_T) deriving instance TextShow CSpeed # endif # if defined(HTYPE_TCFLAG_T) deriving instance TextShow CTcflag # endif # if defined(HTYPE_RLIM_T) deriving instance TextShow CRLim # endif #else # if defined(HTYPE_DEV_T) instance TextShow CDev where showb = showbCDev INLINE_INST_FUN(showb) # endif # if defined(HTYPE_INO_T) instance TextShow CIno where showb = showbCIno INLINE_INST_FUN(showb) # endif # if defined(HTYPE_MODE_T) instance TextShow CMode where showb = showbCMode INLINE_INST_FUN(showb) # endif # if defined(HTYPE_OFF_T) instance TextShow COff where showbPrec = showbCOffPrec INLINE_INST_FUN(showbPrec) # endif # if defined(HTYPE_PID_T) instance TextShow CPid where showbPrec = showbCPidPrec INLINE_INST_FUN(showbPrec) # endif # if defined(HTYPE_SSIZE_T) instance TextShow CSsize where showbPrec = showbCSsizePrec INLINE_INST_FUN(showbPrec) # endif # if defined(HTYPE_GID_T) instance TextShow CGid where showb = showbCGid INLINE_INST_FUN(showb) # endif # if defined(HTYPE_NLINK_T) instance TextShow CNlink where showb = showbCNlink INLINE_INST_FUN(showb) # endif # if defined(HTYPE_UID_T) instance TextShow CUid where showb = showbCUid INLINE_INST_FUN(showb) # endif # if defined(HTYPE_CC_T) instance TextShow CCc where showb = showbCCc INLINE_INST_FUN(showb) # endif # if defined(HTYPE_SPEED_T) instance TextShow CSpeed where showb = showbCSpeed INLINE_INST_FUN(showb) # endif # if defined(HTYPE_TCFLAG_T) instance TextShow CTcflag where showb = showbCTcflag INLINE_INST_FUN(showb) # endif # if defined(HTYPE_RLIM_T) instance TextShow CRLim where showb = showbCRLim INLINE_INST_FUN(showb) # endif #endif deriving instance TextShow Fd text-show-2.1.1/src/TextShow/TH/0000755000000000000000000000000012575552406014545 5ustar0000000000000000text-show-2.1.1/src/TextShow/TH/Internal.hs0000644000000000000000000014555312575552406016672 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TemplateHaskell #-} {-| Module: TextShow.TH.Internal Copyright: (C) 2014-2015 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 , makeShowbPrecWith , makeShowbPrec1 , makeShowbPrecWith2 , makeShowbPrec2 ) where import Data.Function (on) import Data.List.Compat import qualified Data.List.NonEmpty as NE import Data.List.NonEmpty (NonEmpty(..), (<|)) import qualified Data.Map as Map (fromList, lookup) import Data.Map (Map) import Data.Maybe (fromMaybe) import Data.Monoid.Compat ((<>)) import qualified Data.Set as Set import Data.Set (Set) import qualified Data.Text as TS () import qualified Data.Text.IO as TS (putStrLn, hPutStrLn) import Data.Text.Lazy (toStrict) import Data.Text.Lazy.Builder (Builder, fromString, singleton, toLazyText) import qualified Data.Text.Lazy as TL () import qualified Data.Text.Lazy.IO as TL (putStrLn, hPutStrLn) import GHC.Exts (Char(..), Double(..), Float(..), Int(..), Word(..)) import GHC.Prim (Char#, Double#, Float#, Int#, Word#) import GHC.Show (appPrec, appPrec1) import Language.Haskell.TH.Lib import Language.Haskell.TH.Ppr hiding (appPrec) import Language.Haskell.TH.Syntax import Prelude () import Prelude.Compat import TextShow.Classes (TextShow(..), TextShow1(..), TextShow2(..), showbListWith, showbParen, showbSpace) import TextShow.Utils (isInfixTypeCon, isTupleString) ------------------------------------------------------------------------------- -- User-facing API ------------------------------------------------------------------------------- {- $deriveTextShow 'deriveTextShow' automatically generates a 'TextShow' instance declaration for a data type, newtype, or data family instance. This emulates what would (hypothetically) happen if you could attach a @deriving 'TextShow'@ clause to the end of a data declaration. Here are some examples of how to derive 'TextShow' for simple data types: @ {-# 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 = 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 'makeShowbPrecWith'. * If using @-XDatatypeContexts@, a datatype constraint cannot mention the last type variable. For example, @data Ord a => Illegal a = Illegal a@ cannot have a derived 'TextShow1' instance. * If the last type variable is used within a data field of a constructor, it must only be used in the last argument of the data type constructor. For example, @data Legal a = Legal (Either Int a)@ can have a derived 'TextShow1' instance, but @data Illegal a = Illegal (Either a a)@ cannot. * Data family instances must be able to eta-reduce the last type variable. In other words, if you have a instance of the form: @ data family Family a1 ... an t data instance Family e1 ... e2 v = ... @ Then the following conditions must hold: 1. @v@ must be a type variable. 2. @v@ must not be mentioned in any of @e1@, ..., @e2@. * In GHC 7.8, a bug exists that can cause problems when a data family declaration and one of its data instances use different type variables, e.g., @ data family Foo a b c data instance Foo Int y z = Foo Int y z $('deriveTextShow1' 'Foo) @ To avoid this issue, it is recommened that you use the same type variables in the same positions in which they appeared in the data family declaration: @ data family Foo a b c data instance Foo Int b c = Foo Int b c $('deriveTextShow1' 'Foo) @ -} -- | Generates a 'TextShow1' instance declaration for the given data type or data -- family instance. -- -- /Since: 2/ deriveTextShow1 :: Name -> Q [Dec] deriveTextShow1 = deriveTextShowClass TextShow1 {- $deriveTextShow2 'deriveTextShow2' automatically generates a 'TextShow2' instance declaration for a data type, newtype, or data family instance that has at least two type variables. This emulates what would (hypothetically) happen if you could attach a @deriving 'TextShow2'@ clause to the end of a data declaration. Examples: @ {-# 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 'makeShowbPrecWith2'. * If using @-XDatatypeContexts@, a datatype constraint cannot mention either of the last two type variables. For example, @data Ord a => Illegal a b = Illegal a b@ cannot have a derived 'TextShow2' instance. * If either of the last two type variables is used within a data field of a constructor, it must only be used in the last two arguments of the data type constructor. For example, @data Legal a b = Legal (Int, Int, a, b)@ can have a derived 'TextShow2' instance, but @data Illegal a b = Illegal (a, b, a, b)@ cannot. * Data family instances must be able to eta-reduce the last two type variables. In other words, if you have a instance of the form: @ data family Family a1 ... an t1 t2 data instance Family e1 ... e2 v1 v2 = ... @ Then the following conditions must hold: 1. @v1@ and @v2@ must be distinct type variables. 2. Neither @v1@ not @v2@ must be mentioned in any of @e1@, ..., @e2@. -} -- | Generates a 'TextShow2' instance declaration for the given data type or data -- family instance. -- -- /Since: 2/ deriveTextShow2 :: Name -> Q [Dec] deriveTextShow2 = deriveTextShowClass TextShow2 {- $make There may be scenarios in which you want to show an arbitrary data type or data family instance without having to make the type an instance of 'TextShow'. For these cases, this modules provides several functions (all prefixed with @make@-) that splice the appropriate lambda expression into your source code. Example: This is particularly useful for creating instances for sophisticated data types. For example, 'deriveTextShow' cannot infer the correct type context for @newtype HigherKinded f a = HigherKinded (f a)@, since @f@ is of kind @* -> *@. However, it is still possible to derive a 'TextShow' instance for @HigherKinded@ without too much trouble using 'makeShowbPrec': @ {-# 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 = [| toStrict . $(makeShowtl name) |] -- | Generates a lambda expression which behaves like 'showtl' (without requiring a -- 'TextShow' instance). -- -- /Since: 2/ makeShowtl :: Name -> Q Exp makeShowtl name = [| toLazyText . $(makeShowb name) |] -- | Generates a lambda expression which behaves like 'showtPrec' (without requiring a -- 'TextShow' instance). -- -- /Since: 2/ makeShowtPrec :: Name -> Q Exp makeShowtPrec name = [| \p -> toStrict . $(makeShowtlPrec name) p |] -- | Generates a lambda expression which behaves like 'showtlPrec' (without -- requiring a 'TextShow' instance). -- -- /Since: 2/ makeShowtlPrec :: Name -> Q Exp makeShowtlPrec name = [| \p -> toLazyText . $(makeShowbPrec name) p |] -- | Generates a lambda expression which behaves like 'showtList' (without requiring a -- 'TextShow' instance). -- -- /Since: 2/ makeShowtList :: Name -> Q Exp makeShowtList name = [| toStrict . $(makeShowtlList name) |] -- | Generates a lambda expression which behaves like 'showtlList' (without -- requiring a 'TextShow' instance). -- -- /Since: 2/ makeShowtlList :: Name -> Q Exp makeShowtlList name = [| toLazyText . $(makeShowbList name) |] -- | Generates a lambda expression which behaves like 'showb' (without requiring a -- 'TextShow' instance). -- -- /Since: 2/ makeShowb :: Name -> Q Exp makeShowb name = makeShowbPrec name `appE` [| zero |] where -- To prevent the generated TH code from having a type ascription zero :: Int zero = 0 -- | Generates a lambda expression which behaves like 'showbPrec' (without requiring a -- 'TextShow' instance). -- -- /Since: 2/ makeShowbPrec :: Name -> Q Exp makeShowbPrec = makeShowbPrecClass TextShow -- | Generates a lambda expression which behaves like 'showbPrecWith' (without -- requiring a 'TextShow1' instance). -- -- /Since: 2/ makeShowbPrecWith :: Name -> Q Exp makeShowbPrecWith = makeShowbPrecClass TextShow1 -- | Generates a lambda expression which behaves like 'showbPrec1' (without -- requiring a 'TextShow1' instance). -- -- /Since: 2/ makeShowbPrec1 :: Name -> Q Exp makeShowbPrec1 name = [| $(makeShowbPrecWith name) showbPrec |] -- | Generates a lambda expression which behaves like 'showbPrecWith2' (without -- requiring a 'TextShow2' instance). -- -- /Since: 2/ makeShowbPrecWith2 :: Name -> Q Exp makeShowbPrecWith2 = makeShowbPrecClass TextShow2 -- | Generates a lambda expression which behaves like 'showbPrecWith2' (without -- requiring a 'TextShow2' instance). -- -- /Since: 2/ makeShowbPrec2 :: Name -> Q Exp makeShowbPrec2 name = [| $(makeShowbPrecWith2 name) showbPrec showbPrec |] -- | Generates a lambda expression which behaves like 'showbList' (without requiring a -- 'TextShow' instance). -- -- /Since: 2/ makeShowbList :: Name -> Q Exp makeShowbList name = [| showbListWith $(makeShowb name) |] -- | Generates a lambda expression which behaves like 'printT' (without requiring a -- 'TextShow' instance). -- -- /Since: 2/ makePrintT :: Name -> Q Exp makePrintT name = [| TS.putStrLn . $(makeShowt name) |] -- | Generates a lambda expression which behaves like 'printTL' (without requiring a -- 'TextShow' instance). -- -- /Since: 2/ makePrintTL :: Name -> Q Exp makePrintTL name = [| TL.putStrLn . $(makeShowtl name) |] -- | Generates a lambda expression which behaves like 'hPrintT' (without requiring a -- 'TextShow' instance). -- -- /Since: 2/ makeHPrintT :: Name -> Q Exp makeHPrintT name = [| \h -> TS.hPutStrLn h . $(makeShowt name) |] -- | Generates a lambda expression which behaves like 'hPrintTL' (without -- requiring a 'TextShow' instance). -- -- /Since: 2/ makeHPrintTL :: Name -> Q Exp makeHPrintTL name = [| \h -> TL.hPutStrLn h . $(makeShowtl name) |] ------------------------------------------------------------------------------- -- Code generation ------------------------------------------------------------------------------- -- | Derive a TextShow(1)(2) instance declaration (depending on the TextShowClass -- argument's value). deriveTextShowClass :: TextShowClass -> Name -> Q [Dec] deriveTextShowClass tsClass name = withType name fromCons where fromCons :: Name -> Cxt -> [TyVarBndr] -> [Con] -> Maybe [Type] -> Q [Dec] fromCons name' ctxt tvbs cons mbTys = (:[]) <$> instanceD (return instanceCxt) (return instanceType) (showbPrecDecs droppedNbs cons) where (instanceCxt, instanceType, droppedNbs) = buildTypeInstance tsClass name' ctxt tvbs mbTys -- | Generates a declaration defining the primary function corresponding to a -- particular class (showbPrec for TextShow, showbPrecWith for TextShow1, and -- showbPrecWith2 for TextShow2). showbPrecDecs :: [NameBase] -> [Con] -> [Q Dec] showbPrecDecs nbs cons = [ funD classFuncName [ clause [] (normalB $ makeTextShowForCons nbs cons) [] ] ] where classFuncName :: Name classFuncName = showbPrecName . toEnum $ length nbs -- | Generates a lambda expression which behaves like showbPrec (for TextShow), -- showbPrecWith (for TextShow1), or showbPrecWth2 (for TextShow2). makeShowbPrecClass :: TextShowClass -> Name -> Q Exp makeShowbPrecClass tsClass name = withType name fromCons where fromCons :: Name -> Cxt -> [TyVarBndr] -> [Con] -> Maybe [Type] -> Q Exp fromCons name' ctxt tvbs cons mbTys = let (_, _, !nbs) = buildTypeInstance tsClass name' ctxt tvbs mbTys in makeTextShowForCons nbs cons -- | Generates a lambda expression for showbPrec(With)(2) for the given constructors. -- All constructors must be from the same type. makeTextShowForCons :: [NameBase] -> [Con] -> Q Exp makeTextShowForCons _ [] = error "Must have at least one data constructor" makeTextShowForCons nbs cons = do p <- newName "p" value <- newName "value" sps <- newNameList "sp" $ length nbs let tvis = zip nbs sps tsClass = toEnum $ length nbs lamE (map varP $ sps ++ [p, value]) . appsE $ [ varE $ showbPrecConstName tsClass , caseE (varE value) $ map (makeTextShowForCon p tsClass tvis) cons ] ++ map varE sps ++ [varE p, varE value] -- | Generates a lambda expression for showbPrec(With)(2) for a single constructor. makeTextShowForCon :: Name -> TextShowClass -> [TyVarInfo] -> Con -> Q Match makeTextShowForCon _ _ _ (NormalC conName []) = match (conP conName []) (normalB [| fromString $(stringE (parenInfixConName conName "")) |]) [] makeTextShowForCon p tsClass tvis (NormalC conName [(_, argTy)]) = do arg <- newName "arg" let showArg = makeTextShowForArg appPrec1 tsClass conName tvis argTy arg namedArg = [| fromString $(stringE (parenInfixConName conName " ")) <> $(showArg) |] match (conP conName [varP arg]) (normalB [| showbParen ($(varE p) > $(lift appPrec)) $(namedArg) |]) [] makeTextShowForCon p tsClass tvis (NormalC conName ts) = do args <- newNameList "arg" $ length ts if isNonUnitTuple conName then do let showArgs = map (\(arg, (_, argTy)) -> makeTextShowForArg 0 tsClass conName tvis argTy arg) (zip args ts) parenCommaArgs = [| singleton '(' |] : intersperse [| singleton ',' |] showArgs mappendArgs = foldr (`infixApp` [| (<>) |]) [| singleton ')' |] parenCommaArgs match (conP conName $ map varP args) (normalB mappendArgs) [] else do let showArgs = map (\(arg, (_, argTy)) -> makeTextShowForArg appPrec1 tsClass conName tvis argTy arg) (zip args ts) mappendArgs = foldr1 (\v q -> [| $(v) <> showbSpace <> $(q) |]) showArgs namedArgs = [| fromString $(stringE (parenInfixConName conName " ")) <> $(mappendArgs) |] match (conP conName $ map varP args) (normalB [| showbParen ($(varE p) > $(lift appPrec)) $(namedArgs) |]) [] makeTextShowForCon p tsClass tvis (RecC conName []) = makeTextShowForCon p tsClass tvis $ NormalC conName [] makeTextShowForCon _p tsClass tvis (RecC conName ts) = do args <- newNameList "arg" $ length ts let showArgs = concatMap (\(arg, (argName, _, argTy)) -> [ [| fromString $(stringE (nameBase argName ++ " = ")) |] , makeTextShowForArg 0 tsClass conName tvis argTy arg , [| fromString ", " |] ] ) (zip args ts) braceCommaArgs = [| singleton '{' |] : take (length showArgs - 1) showArgs mappendArgs = foldr (`infixApp` [| (<>) |]) [| singleton '}' |] braceCommaArgs namedArgs = [| fromString $(stringE (parenInfixConName conName " ")) <> $(mappendArgs) |] match (conP conName $ map varP args) (normalB #if __GLASGOW_HASKELL__ >= 711 namedArgs #else [| showbParen ($(varE _p) > $(lift appPrec)) $(namedArgs) |] #endif ) [] makeTextShowForCon p tsClass tvis (InfixC (_, alTy) conName (_, arTy)) = do al <- newName "argL" ar <- newName "argR" info <- reify conName #if __GLASGOW_HASKELL__ >= 711 conPrec <- case info of DataConI{} -> do Fixity prec _ <- reifyFixity conName return prec #else let conPrec = case info of DataConI _ _ _ (Fixity prec _) -> prec #endif _ -> error $ "TextShow.TH.makeTextShowForCon: Unsupported type: " ++ show info let opName = nameBase conName infixOpE = if isInfixTypeCon opName then [| fromString $(stringE $ " " ++ opName ++ " " ) |] else [| fromString $(stringE $ " `" ++ opName ++ "` ") |] match (infixP (varP al) conName (varP ar)) (normalB $ appE [| showbParen ($(varE p) > conPrec) |] [| $(makeTextShowForArg (conPrec + 1) tsClass conName tvis alTy al) <> $(infixOpE) <> $(makeTextShowForArg (conPrec + 1) tsClass conName tvis arTy ar) |] ) [] makeTextShowForCon p tsClass tvis (ForallC tvbs _ con) = makeTextShowForCon p tsClass (removeForalled tvbs tvis) con -- | Generates a lambda expression for showbPrec(With)(2) for an argument of a -- constructor. makeTextShowForArg :: Int -> TextShowClass -> Name -> [TyVarInfo] -> Type -> Name -> Q Exp makeTextShowForArg p tsClass conName tvis ty tyExpName = do ty' <- expandSyn ty makeTextShowForArg' p tsClass conName tvis ty' tyExpName -- | Generates a lambda expression for showbPrec(With)(2) for an argument of a -- constructor, after expanding all type synonyms. makeTextShowForArg' :: Int -> TextShowClass -> Name -> [TyVarInfo] -> Type -> Name -> Q Exp makeTextShowForArg' p _ _ _ (ConT tyName) tyExpName = #if __GLASGOW_HASKELL__ >= 711 -- Starting with GHC 7.10, data types containing unlifted types with derived @Show@ -- instances show hashed literals with actual hash signs, and negative hashed -- literals are not surrounded with parentheses. showE where tyVarE :: Q Exp tyVarE = varE tyExpName showE :: Q Exp showE | tyName == ''Char# = [| showbPrec 0 (C# $(tyVarE)) <> singleton '#' |] | tyName == ''Double# = [| showbPrec 0 (D# $(tyVarE)) <> fromString "##" |] | tyName == ''Float# = [| showbPrec 0 (F# $(tyVarE)) <> singleton '#' |] | tyName == ''Int# = [| showbPrec 0 (I# $(tyVarE)) <> singleton '#' |] | tyName == ''Word# = [| showbPrec 0 (W# $(tyVarE)) <> fromString "##" |] | otherwise = [| showbPrec p $(tyVarE) |] #else [| showbPrec p $(expr) |] where tyVarE :: Q Exp tyVarE = varE tyExpName expr :: Q Exp expr | tyName == ''Char# = [| C# $(tyVarE) |] | tyName == ''Double# = [| D# $(tyVarE) |] | tyName == ''Float# = [| F# $(tyVarE) |] | tyName == ''Int# = [| I# $(tyVarE) |] | tyName == ''Word# = [| W# $(tyVarE) |] | otherwise = tyVarE #endif makeTextShowForArg' p tsClass conName tvis ty tyExpName = [| $(makeTextShowForType tsClass conName tvis ty) p $(varE tyExpName) |] -- | Generates a lambda expression for showbPrec(With)(2) for a specific type. -- The generated expression depends on the number of type variables. -- -- 1. If the type is of kind * (T), apply showbPrec. -- 2. If the type is of kind * -> * (T a), apply showbPrecWith $(makeTextShowForType a) -- 3. If the type is of kind * -> * -> * (T a b), apply -- showbPrecWith2 $(makeTextShowForType a) $(makeTextShowForType b) makeTextShowForType :: TextShowClass -> Name -> [TyVarInfo] -> Type -> Q Exp makeTextShowForType _ _ tvis (VarT tyName) = case lookup (NameBase tyName) tvis of Just spExp -> varE spExp Nothing -> [| showbPrec |] makeTextShowForType tsClass conName tvis (SigT ty _) = makeTextShowForType tsClass conName tvis ty makeTextShowForType tsClass conName tvis (ForallT tvbs _ ty) = makeTextShowForType tsClass conName (removeForalled tvbs tvis) ty makeTextShowForType tsClass conName tvis ty = do let tyArgs :: [Type] tyCon :| tyArgs = unapplyTy ty numLastArgs :: Int numLastArgs = min (fromEnum tsClass) (length tyArgs) lhsArgs, rhsArgs :: [Type] (lhsArgs, rhsArgs) = splitAt (length tyArgs - numLastArgs) tyArgs tyVarNameBases :: [NameBase] tyVarNameBases = map fst tvis itf <- isTyFamily tyCon if any (`mentionsNameBase` tyVarNameBases) lhsArgs || itf && any (`mentionsNameBase` tyVarNameBases) tyArgs then outOfPlaceTyVarError conName tyVarNameBases else appsE $ [ varE . showbPrecName $ toEnum numLastArgs] ++ map (makeTextShowForType tsClass conName tvis) rhsArgs ------------------------------------------------------------------------------- -- Template Haskell reifying and AST manipulation ------------------------------------------------------------------------------- -- | Extracts a plain type constructor's information. -- | Boilerplate for top level splices. -- -- The given Name must meet one of two criteria: -- -- 1. It must be the name of a type constructor of a plain data type or newtype. -- 2. It must be the name of a data family instance or newtype instance constructor. -- -- Any other value will result in an exception. withType :: Name -> (Name -> Cxt -> [TyVarBndr] -> [Con] -> Maybe [Type] -> Q a) -> Q a withType name f = do info <- reify name case info of TyConI dec -> case dec of DataD ctxt _ tvbs cons _ -> f name ctxt tvbs cons Nothing NewtypeD ctxt _ tvbs con _ -> f name ctxt tvbs [con] Nothing _ -> error $ ns ++ "Unsupported type: " ++ show dec #if MIN_VERSION_template_haskell(2,7,0) # if MIN_VERSION_template_haskell(2,11,0) DataConI _ _ parentName -> do # else DataConI _ _ parentName _ -> do # endif parentInfo <- reify parentName case parentInfo of # if MIN_VERSION_template_haskell(2,11,0) FamilyI (DataFamilyD _ tvbs _) decs -> # else FamilyI (FamilyD DataFam _ tvbs _) decs -> # endif let instDec = flip find decs $ \dec -> case dec of DataInstD _ _ _ cons _ -> any ((name ==) . constructorName) cons NewtypeInstD _ _ _ con _ -> name == constructorName con _ -> error $ ns ++ "Must be a data or newtype instance." in case instDec of Just (DataInstD ctxt _ instTys cons _) -> f parentName ctxt tvbs cons $ Just instTys Just (NewtypeInstD ctxt _ instTys con _) -> f parentName ctxt tvbs [con] $ Just instTys _ -> error $ ns ++ "Could not find data or newtype instance constructor." _ -> error $ ns ++ "Data constructor " ++ show name ++ " is not from a data family instance constructor." # if MIN_VERSION_template_haskell(2,11,0) FamilyI DataFamilyD{} _ -> # else FamilyI (FamilyD DataFam _ _ _) _ -> # endif error $ ns ++ "Cannot use a data family name. Use a data family instance constructor instead." _ -> error $ ns ++ "The name must be of a plain data type constructor, " ++ "or a data family instance constructor." #else DataConI{} -> dataConIError _ -> error $ ns ++ "The name must be of a plain type constructor." #endif where ns :: String ns = "TextShow.TH.withType: " -- | Deduces the instance context, instance head, and eta-reduced type variables -- for an instance. buildTypeInstance :: TextShowClass -- ^ TextShow, TextShow1, or TextShow2 -> Name -- ^ The type constructor or data family name -> Cxt -- ^ The datatype context -> [TyVarBndr] -- ^ The type variables from the data type/data family declaration -> Maybe [Type] -- ^ 'Just' the types used to instantiate a data family instance, -- or 'Nothing' if it's a plain data type -> (Cxt, Type, [NameBase]) -- Plain data type/newtype case buildTypeInstance tsClass tyConName dataCxt tvbs Nothing | remainingLength < 0 || not (wellKinded droppedKinds) -- If we have enough well-kinded type variables = derivingKindError tsClass tyConName | any (`predMentionsNameBase` droppedNbs) dataCxt -- If the last type variable(s) are mentioned in a datatype context = datatypeContextError tyConName instanceType | otherwise = (instanceCxt, instanceType, droppedNbs) where instanceCxt :: Cxt instanceCxt = map (applyShowConstraint) $ filter (needsConstraint tsClass . tvbKind) remaining instanceType :: Type instanceType = AppT (ConT $ textShowClassName tsClass) . applyTyCon tyConName $ map (VarT . tvbName) remaining remainingLength :: Int remainingLength = length tvbs - fromEnum tsClass remaining, dropped :: [TyVarBndr] (remaining, dropped) = splitAt remainingLength tvbs droppedKinds :: [Kind] droppedKinds = map tvbKind dropped droppedNbs :: [NameBase] droppedNbs = map (NameBase . tvbName) dropped -- Data family instance case buildTypeInstance tsClass parentName dataCxt tvbs (Just instTysAndKinds) | remainingLength < 0 || not (wellKinded droppedKinds) -- If we have enough well-kinded type variables = derivingKindError tsClass parentName | any (`predMentionsNameBase` droppedNbs) dataCxt -- If the last type variable(s) are mentioned in a datatype context = datatypeContextError parentName instanceType | canEtaReduce remaining dropped -- If it is safe to drop the type variables = (instanceCxt, instanceType, droppedNbs) | otherwise = etaReductionError instanceType where instanceCxt :: Cxt instanceCxt = map (applyShowConstraint) $ filter (needsConstraint tsClass . tvbKind) lhsTvbs -- We need to make sure that type variables in the instance head which have -- TextShow constrains aren't poly-kinded, e.g., -- -- @ -- instance TextShow a => TextShow (Foo (a :: k)) where -- @ -- -- To do this, we remove every kind ascription (i.e., strip off every 'SigT'). instanceType :: Type instanceType = AppT (ConT $ textShowClassName tsClass) . applyTyCon parentName $ map unSigT remaining remainingLength :: Int remainingLength = length tvbs - fromEnum tsClass remaining, dropped :: [Type] (remaining, dropped) = splitAt remainingLength rhsTypes droppedKinds :: [Kind] droppedKinds = map tvbKind . snd $ splitAt remainingLength tvbs droppedNbs :: [NameBase] droppedNbs = map varTToNameBase dropped -- We need to mindful of an old GHC bug which causes kind variables appear in -- @instTysAndKinds@ (as the name suggests) if (1) @PolyKinds@ is enabled, and -- (2) either GHC 7.6 or 7.8 is being used (for more info, see -- https://ghc.haskell.org/trac/ghc/ticket/9692). -- -- Since Template Haskell doesn't seem to have a mechanism for detecting which -- language extensions are enabled, we do the next-best thing by counting -- the number of distinct kind variables in the data family declaration, and -- then dropping that number of entries from @instTysAndKinds@ instTypes :: [Type] instTypes = #if __GLASGOW_HASKELL__ >= 710 || !(MIN_VERSION_template_haskell(2,8,0)) instTysAndKinds #else drop (Set.size . Set.unions $ map (distinctKindVars . tvbKind) tvbs) instTysAndKinds #endif lhsTvbs :: [TyVarBndr] lhsTvbs = map (uncurry replaceTyVarName) . filter (isTyVar . snd) . take remainingLength $ zip tvbs rhsTypes -- In GHC 7.8, only the @Type@s up to the rightmost non-eta-reduced type variable -- in @instTypes@ are provided (as a result of this extremely annoying bug: -- https://ghc.haskell.org/trac/ghc/ticket/9692). This is pretty inconvenient, -- as it makes it impossible to come up with the correct 'TextShow1' or 'TextShow2' -- instances in some cases. For example, consider the following code: -- -- @ -- data family Foo a b c -- data instance Foo Int y z = Foo Int y z -- $(deriveTextShow2 'Foo) -- @ -- -- Due to the aformentioned bug, Template Haskell doesn't tell us the names of -- either of type variables in the data instance (@y@ and @z@). As a result, we -- won't know which fields of the 'Foo' constructor to apply the show functions, -- which will result in an incorrect instance. Urgh. -- -- A workaround is to ensure that you use the exact same type variables, in the -- exact same order, in the data family declaration and any data or newtype -- instances: -- -- @ -- data family Foo a b c -- data instance Foo Int b c = Foo Int b c -- $(deriveTextShow2 'Foo) -- @ -- -- Thankfully, other versions of GHC don't seem to have this bug. rhsTypes :: [Type] rhsTypes = #if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710 instTypes ++ map tvbToType (drop (length instTypes) tvbs) #else instTypes #endif -- | Given a TyVarBndr, apply a TextShow(1)(2) constraint to it, depending -- on its kind. applyShowConstraint :: TyVarBndr -> Pred applyShowConstraint (PlainTV name) = applyClass ''TextShow name applyShowConstraint (KindedTV name kind) = applyClass className name where className :: Name className = textShowClassName . toEnum $ numKindArrows kind -- | Can a kind signature inhabit a TextShow(1)(2) constraint? -- -- TextShow: k -- TextShow1: k1 -> k2 -- TextShow2: k1 -> k2 -> k3 needsConstraint :: TextShowClass -> Kind -> Bool needsConstraint tsClass kind = fromEnum tsClass >= numKindArrows kind && canRealizeKindStarChain kind ------------------------------------------------------------------------------- -- Error messages ------------------------------------------------------------------------------- -- | Either the given data type doesn't have enough type variables, or one of -- the type variables to be eta-reduced cannot realize kind *. derivingKindError :: TextShowClass -> Name -> a derivingKindError tsClass tyConName = error . showString "Cannot derive well-kinded instance of form ‘" . showString className . showChar ' ' . showParen True ( showString (nameBase tyConName) . showString " ..." ) . showString "‘\n\tClass " . showString className . showString " expects an argument of kind " . showString (pprint . createKindChain $ fromEnum tsClass) $ "" where className :: String className = nameBase $ textShowClassName tsClass -- | One of the last type variables cannot be eta-reduced (see the canEtaReduce -- function for the criteria it would have to meet). etaReductionError :: Type -> a etaReductionError instanceType = error $ "Cannot eta-reduce to an instance of form \n\tinstance (...) => " ++ pprint instanceType -- | The data type has a DatatypeContext which mentions one of the eta-reduced -- type variables. datatypeContextError :: Name -> Type -> a datatypeContextError dataName instanceType = error . showString "Can't make a derived instance of ‘" . showString (pprint instanceType) . showString "‘:\n\tData type ‘" . showString (nameBase dataName) . showString "‘ must not have a class context involving the last type argument(s)" $ "" -- | The data type mentions one of the n eta-reduced type variables in a place other -- than the last nth positions of a data type in a constructor's field. outOfPlaceTyVarError :: Name -> [NameBase] -> a outOfPlaceTyVarError conName tyVarNames = error . showString "Constructor ‘" . showString (nameBase conName) . showString "‘ must use the type variable(s) " . shows tyVarNames . showString " only in the last argument(s) of a data type" $ "" #if !(MIN_VERSION_template_haskell(2,7,0)) -- | Template Haskell didn't list all of a data family's instances upon reification -- until template-haskell-2.7.0.0, which is necessary for a derived TextShow(1)(2) -- instance to work. dataConIError :: a dataConIError = error . showString "Cannot use a data constructor." . showString "\n\t(Note: if you are trying to derive TextShow for a" . showString "\n\ttype family, use GHC >= 7.4 instead.)" $ "" #endif ------------------------------------------------------------------------------- -- Expanding type synonyms ------------------------------------------------------------------------------- -- | Expands all type synonyms in a type. Written by Dan Rosén in the -- @genifunctors@ package (licensed under BSD3). expandSyn :: Type -> Q Type expandSyn (ForallT tvs ctx t) = fmap (ForallT tvs ctx) $ expandSyn t expandSyn t@AppT{} = expandSynApp t [] expandSyn t@ConT{} = expandSynApp t [] expandSyn (SigT t _) = expandSyn t -- Ignore kind synonyms expandSyn t = return t expandSynApp :: Type -> [Type] -> Q Type expandSynApp (AppT t1 t2) ts = do t2' <- expandSyn t2 expandSynApp t1 (t2':ts) expandSynApp (ConT n) ts | nameBase n == "[]" = return $ foldl' AppT ListT ts expandSynApp t@(ConT n) ts = do info <- reify n case info of TyConI (TySynD _ tvs rhs) -> let (ts', ts'') = splitAt (length tvs) ts subs = mkSubst tvs ts' rhs' = subst subs rhs in expandSynApp rhs' ts'' _ -> return $ foldl' AppT t ts expandSynApp t ts = do t' <- expandSyn t return $ foldl' AppT t' ts type Subst = Map Name Type mkSubst :: [TyVarBndr] -> [Type] -> Subst mkSubst vs ts = let vs' = map un vs un (PlainTV v) = v un (KindedTV v _) = v in Map.fromList $ zip vs' ts subst :: Subst -> Type -> Type subst subs (ForallT v c t) = ForallT v c $ subst subs t subst subs t@(VarT n) = fromMaybe t $ Map.lookup n subs subst subs (AppT t1 t2) = AppT (subst subs t1) (subst subs t2) subst subs (SigT t k) = SigT (subst subs t) k subst _ t = t ------------------------------------------------------------------------------- -- Class-specific constants ------------------------------------------------------------------------------- -- | A representation of which TextShow variant is being derived. data TextShowClass = TextShow | TextShow1 | TextShow2 deriving (Enum, Eq, Ord) showbPrecConstName :: TextShowClass -> Name showbPrecConstName TextShow = 'showbPrecConst showbPrecConstName TextShow1 = 'showbPrecWithConst showbPrecConstName TextShow2 = 'showbPrecWith2Const textShowClassName :: TextShowClass -> Name textShowClassName TextShow = ''TextShow textShowClassName TextShow1 = ''TextShow1 textShowClassName TextShow2 = ''TextShow2 showbPrecName :: TextShowClass -> Name showbPrecName TextShow = 'showbPrec showbPrecName TextShow1 = 'showbPrecWith showbPrecName TextShow2 = 'showbPrecWith2 -- | A type-restricted version of 'const'. This is useful when generating the lambda -- expression in 'makeShowbPrec' for a data type with only nullary constructors (since -- the expression wouldn't depend on the precedence). For example, if you had @data -- Nullary = Nullary@ and attempted to run @$(makeShowbPrec ''Nullary) Nullary@, simply -- ignoring the precedence argument would cause the type signature of @$(makeShowbPrec -- ''Nullary)@ to be @a -> Nullary -> Builder@, not @Int -> Nullary -> Builder@. showbPrecConst :: Builder -> Int -> a -> Builder showbPrecConst = const . const {-# INLINE showbPrecConst #-} showbPrecWithConst :: Builder -> (Int -> a -> Builder) -> Int -> f a -> Builder showbPrecWithConst = const . const . const {-# INLINE showbPrecWithConst #-} showbPrecWith2Const :: Builder -> (Int -> a -> Builder) -> (Int -> b -> Builder) -> Int -> f a b -> Builder showbPrecWith2Const = const . const . const . const {-# INLINE showbPrecWith2Const #-} ------------------------------------------------------------------------------- -- NameBase ------------------------------------------------------------------------------- -- | A wrapper around Name which only uses the 'nameBase' (not the entire Name) -- to compare for equality. For example, if you had two Names a_123 and a_456, -- they are not equal as Names, but they are equal as NameBases. -- -- This is useful when inspecting type variables, since a type variable in an -- instance context may have a distinct Name from a type variable within an -- actual constructor declaration, but we'd want to treat them as the same -- if they have the same 'nameBase' (since that's what the programmer uses to -- begin with). newtype NameBase = NameBase { getName :: Name } getNameBase :: NameBase -> String getNameBase = nameBase . getName instance Eq NameBase where (==) = (==) `on` getNameBase instance Ord NameBase where compare = compare `on` getNameBase instance Show NameBase where showsPrec p = showsPrec p . getNameBase -- | A NameBase paired with the name of its show function. For example, in a -- TextShow2 declaration, a list of TyVarInfos might look like [(a, 'sp1), (b, 'sp2)]. type TyVarInfo = (NameBase, Name) ------------------------------------------------------------------------------- -- Assorted utilities ------------------------------------------------------------------------------- -- | Generate a list of fresh names with a common prefix, and numbered suffixes. newNameList :: String -> Int -> Q [Name] newNameList prefix n = mapM (newName . (prefix ++) . show) [1..n] -- | Remove any occurrences of a forall-ed type variable from a list of @TyVarInfo@s. removeForalled :: [TyVarBndr] -> [TyVarInfo] -> [TyVarInfo] removeForalled tvbs = filter (not . foralled tvbs) where foralled :: [TyVarBndr] -> TyVarInfo -> Bool foralled tvbs' tvi = fst tvi `elem` map (NameBase . tvbName) tvbs' -- | Checks if a 'Name' represents a tuple type constructor (other than '()') isNonUnitTuple :: Name -> Bool isNonUnitTuple = isTupleString . nameBase -- | Parenthesize an infix constructor name if it is being applied as a prefix -- function (e.g., data Amp a = (:&) a a) parenInfixConName :: Name -> ShowS parenInfixConName conName = let conNameBase = nameBase conName in showParen (isInfixTypeCon conNameBase) $ showString conNameBase -- | Extracts the name from a TyVarBndr. tvbName :: TyVarBndr -> Name tvbName (PlainTV name) = name tvbName (KindedTV name _) = name -- | Extracts the kind from a TyVarBndr. tvbKind :: TyVarBndr -> Kind tvbKind (PlainTV _) = starK tvbKind (KindedTV _ k) = k -- | Replace the Name of a TyVarBndr with one from a Type (if the Type has a Name). replaceTyVarName :: TyVarBndr -> Type -> TyVarBndr replaceTyVarName tvb (SigT t _) = replaceTyVarName tvb t replaceTyVarName (PlainTV _) (VarT n) = PlainTV n replaceTyVarName (KindedTV _ k) (VarT n) = KindedTV n k replaceTyVarName tvb _ = tvb -- | Applies a typeclass constraint to a type. applyClass :: Name -> Name -> Pred #if MIN_VERSION_template_haskell(2,10,0) applyClass con t = AppT (ConT con) (VarT t) #else applyClass con t = ClassP con [VarT t] #endif -- | Checks to see if the last types in a data family instance can be safely eta- -- reduced (i.e., dropped), given the other types. This checks for three conditions: -- -- (1) All of the dropped types are type variables -- (2) All of the dropped types are distinct -- (3) None of the remaining types mention any of the dropped types canEtaReduce :: [Type] -> [Type] -> Bool canEtaReduce remaining dropped = all isTyVar dropped && allDistinct nbs -- Make sure not to pass something of type [Type], since Type -- didn't have an Ord instance until template-haskell-2.10.0.0 && not (any (`mentionsNameBase` nbs) remaining) where nbs :: [NameBase] nbs = map varTToNameBase dropped -- | Extract the Name from a type variable. varTToName :: Type -> Name varTToName (VarT n) = n varTToName (SigT t _) = varTToName t varTToName _ = error "Not a type variable!" -- | Extract the NameBase from a type variable. varTToNameBase :: Type -> NameBase varTToNameBase = NameBase . varTToName -- | Peel off a kind signature from a Type (if it has one). unSigT :: Type -> Type unSigT (SigT t _) = t unSigT t = t -- | Is the given type a variable? isTyVar :: Type -> Bool isTyVar (VarT _) = True isTyVar (SigT t _) = isTyVar t isTyVar _ = False -- | Is the given type a type family constructor (and not a data family constructor)? isTyFamily :: Type -> Q Bool isTyFamily (ConT n) = do info <- reify n return $ case info of #if MIN_VERSION_template_haskell(2,11,0) FamilyI OpenTypeFamilyD{} _ -> True #elif MIN_VERSION_template_haskell(2,7,0) FamilyI (FamilyD TypeFam _ _ _) _ -> True #else TyConI (FamilyD TypeFam _ _ _) -> True #endif #if MIN_VERSION_template_haskell(2,9,0) FamilyI ClosedTypeFamilyD{} _ -> True #endif _ -> False isTyFamily _ = return False -- | Are all of the items in a list (which have an ordering) distinct? -- -- This uses Set (as opposed to nub) for better asymptotic time complexity. allDistinct :: Ord a => [a] -> Bool allDistinct = allDistinct' Set.empty where allDistinct' :: Ord a => Set a -> [a] -> Bool allDistinct' uniqs (x:xs) | x `Set.member` uniqs = False | otherwise = allDistinct' (Set.insert x uniqs) xs allDistinct' _ _ = True -- | Does the given type mention any of the NameBases in the list? mentionsNameBase :: Type -> [NameBase] -> Bool mentionsNameBase = go Set.empty where go :: Set NameBase -> Type -> [NameBase] -> Bool go foralls (ForallT tvbs _ t) nbs = go (foralls `Set.union` Set.fromList (map (NameBase . tvbName) tvbs)) t nbs go foralls (AppT t1 t2) nbs = go foralls t1 nbs || go foralls t2 nbs go foralls (SigT t _) nbs = go foralls t nbs go foralls (VarT n) nbs = varNb `elem` nbs && not (varNb `Set.member` foralls) where varNb = NameBase n go _ _ _ = False -- | Does an instance predicate mention any of the NameBases in the list? predMentionsNameBase :: Pred -> [NameBase] -> Bool #if MIN_VERSION_template_haskell(2,10,0) predMentionsNameBase = mentionsNameBase #else predMentionsNameBase (ClassP _ tys) nbs = any (`mentionsNameBase` nbs) tys predMentionsNameBase (EqualP t1 t2) nbs = mentionsNameBase t1 nbs || mentionsNameBase t2 nbs #endif -- | The number of arrows that compose the spine of a kind signature -- (e.g., (* -> *) -> k -> * has two arrows on its spine). numKindArrows :: Kind -> Int numKindArrows k = length (uncurryKind k) - 1 -- | Construct a type via curried application. applyTy :: Type -> [Type] -> Type applyTy = foldl' AppT -- | Fully applies a type constructor to its type variables. applyTyCon :: Name -> [Type] -> Type applyTyCon = applyTy . ConT -- | Split an applied type into its individual components. For example, this: -- -- @ -- Either Int Char -- @ -- -- would split to this: -- -- @ -- [Either, Int, Char] -- @ unapplyTy :: Type -> NonEmpty Type unapplyTy = NE.reverse . go where go :: Type -> NonEmpty Type go (AppT t1 t2) = t2 <| go t1 go (SigT t _) = go t go t = t :| [] -- | Split a type signature by the arrows on its spine. For example, this: -- -- @ -- (Int -> String) -> Char -> () -- @ -- -- would split to this: -- -- @ -- [Int -> String, Char, ()] -- @ uncurryTy :: Type -> NonEmpty Type uncurryTy (AppT (AppT ArrowT t1) t2) = t1 <| uncurryTy t2 uncurryTy (SigT t _) = uncurryTy t uncurryTy t = t :| [] -- | Like uncurryType, except on a kind level. uncurryKind :: Kind -> NonEmpty Kind #if MIN_VERSION_template_haskell(2,8,0) uncurryKind = uncurryTy #else uncurryKind (ArrowK k1 k2) = k1 <| uncurryKind k2 uncurryKind k = k :| [] #endif wellKinded :: [Kind] -> Bool wellKinded = all canRealizeKindStar -- | Of form k1 -> k2 -> ... -> kn, where k is either a single kind variable or *. canRealizeKindStarChain :: Kind -> Bool canRealizeKindStarChain = all canRealizeKindStar . uncurryKind canRealizeKindStar :: Kind -> Bool canRealizeKindStar k = case uncurryKind k of k' :| [] -> case k' of #if MIN_VERSION_template_haskell(2,8,0) StarT -> True (VarT _) -> True -- Kind k can be instantiated with * #else StarK -> True #endif _ -> False _ -> False createKindChain :: Int -> Kind createKindChain = go starK where go :: Kind -> Int -> Kind go k !0 = k #if MIN_VERSION_template_haskell(2,8,0) go k !n = go (AppT (AppT ArrowT StarT) k) (n - 1) #else go k !n = go (ArrowK StarK k) (n - 1) #endif # if MIN_VERSION_template_haskell(2,8,0) && __GLASGOW_HASKELL__ < 710 distinctKindVars :: Kind -> Set Name distinctKindVars (AppT k1 k2) = distinctKindVars k1 `Set.union` distinctKindVars k2 distinctKindVars (SigT k _) = distinctKindVars k distinctKindVars (VarT k) = Set.singleton k distinctKindVars _ = Set.empty #endif #if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710 tvbToType :: TyVarBndr -> Type tvbToType (PlainTV n) = VarT n tvbToType (KindedTV n k) = SigT (VarT n) k #endif #if MIN_VERSION_template_haskell(2,7,0) -- | Extracts the name of a constructor. constructorName :: Con -> Name constructorName (NormalC name _ ) = name constructorName (RecC name _ ) = name constructorName (InfixC _ name _ ) = name constructorName (ForallC _ _ con) = constructorName con #endif text-show-2.1.1/src/TextShow/TH/Names.hs0000644000000000000000000000472612575552406016155 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-| Module: TextShow.TH.Names Copyright: (C) 2014-2015 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 __GLASGOW_HASKELL__ >= 711 import GHC.RTS.Flags (GiveGCStats, DoCostCentres, DoHeapProfile, DoTrace) #endif ------------------------------------------------------------------------------- #if MIN_VERSION_base(4,4,0) mkEventName_v :: String -> Name mkEventName_v = mkNameG_v "base" "GHC.Event.Internal" evtCloseValName :: Name evtCloseValName = mkEventName_v "evtClose" eventIsValName :: Name eventIsValName = mkEventName_v "eventIs" fdKeyTypeName :: Name fdKeyTypeName = mkNameG_tc "base" "GHC.Event.Manager" "FdKey" uniqueTypeName :: Name uniqueTypeName = mkNameG_tc "base" "GHC.Event.Unique" "Unique" asInt64ValName :: Name asInt64ValName = mkNameG_v "base" "GHC.Event.Unique" "asInt64" #endif #if MIN_VERSION_base(4,6,0) 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) giveGCStatsTypeName :: Name # if __GLASGOW_HASKELL__ >= 711 giveGCStatsTypeName = ''GiveGCStats # else giveGCStatsTypeName = mkFlagsName_tc "GiveGCStats" # endif doCostCentresTypeName :: Name # if __GLASGOW_HASKELL__ >= 711 doCostCentresTypeName = ''DoCostCentres # else doCostCentresTypeName = mkFlagsName_tc "DoCostCentres" # endif doHeapProfileTypeName :: Name # if __GLASGOW_HASKELL__ >= 711 doHeapProfileTypeName = ''DoHeapProfile # else doHeapProfileTypeName = mkFlagsName_tc "DoHeapProfile" # endif doTraceTypeName :: Name # if __GLASGOW_HASKELL__ >= 711 doTraceTypeName = ''DoTrace # else doTraceTypeName = mkFlagsName_tc "DoTrace" # endif # if __GLASGOW_HASKELL__ < 711 mkFlagsName_tc :: String -> Name mkFlagsName_tc = mkNameG_tc "base" "GHC.RTS.Flags" # endif #endif text-show-2.1.1/src/TextShow/Debug/0000755000000000000000000000000012575552406015260 5ustar0000000000000000text-show-2.1.1/src/TextShow/Debug/Trace.hs0000644000000000000000000002663112575552406016662 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE OverloadedStrings #-} {-| Module: TextShow.Debug.Trace Copyright: (C) 2014-2015 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, showt) 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-2.1.1/src/TextShow/Debug/Trace/0000755000000000000000000000000012575552406016316 5ustar0000000000000000text-show-2.1.1/src/TextShow/Debug/Trace/Generic.hs0000644000000000000000000000231112575552406020223 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-| Module: TextShow.Debug.Trace.Generic Copyright: (C) 2014-2015 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 (GTextShow, genericShowt) -- | A 'Generic' implementation of 'traceTextShow'. -- -- /Since: 2/ genericTraceTextShow :: (Generic a, GTextShow (Rep a)) => a -> b -> b genericTraceTextShow = tracet . genericShowt -- | A 'Generic' implementation of 'traceTextShowId'. -- -- /Since: 2/ genericTraceTextShowId :: (Generic a, GTextShow (Rep a)) => a -> a genericTraceTextShowId a = tracet (genericShowt a) a -- | A 'Generic' implementation of 'traceShowM'. -- -- /Since: 2/ genericTraceTextShowM :: (Generic a, GTextShow (Rep a), Applicative f) => a -> f () genericTraceTextShowM = tracetM . genericShowt text-show-2.1.1/src/TextShow/Debug/Trace/TH.hs0000644000000000000000000000263312575552406017171 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-| Module: TextShow.Debug.Trace.TH Copyright: (C) 2014-2015 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-2.1.1/src/TextShow/GHC/0000755000000000000000000000000012575552406014633 5ustar0000000000000000text-show-2.1.1/src/TextShow/GHC/Event.hs0000644000000000000000000000563712575552406016263 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-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' functions for data types in the @Event@ module. This module only exports functions if using @base-4.4.0.0@ on a platform other than Windows or GHCJS. /Since: 2/ -} module TextShow.GHC.Event ( #if defined(__GHCJS__) || defined(mingw32_HOST_OS) || !(MIN_VERSION_base(4,4,0)) ) where #else showbEvent , showbFdKeyPrec # if MIN_VERSION_base(4,8,1) , showbLifetime # endif ) where import Data.List (intersperse) import Data.Maybe (catMaybes) import Data.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (Builder, singleton) import GHC.Event (Event, FdKey, evtRead, evtWrite) import Language.Haskell.TH.Lib (conT, varE) import Prelude () import Prelude.Compat import TextShow.Classes (TextShow(showb, showbPrec)) 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 #include "inline.h" -- | Convert an 'Event' to a 'Builder'. -- This function is only available with @base-4.4.0.0@ or later and is not available -- on Windows. -- -- /Since: 2/ showbEvent :: Event -> Builder showbEvent 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 -- | Convert an 'FdKey' to a 'Builder' with the given precedence. -- This function is only available with @base-4.4.0.0@ or later and is not available -- on Windows. -- -- /Since: 2/ showbFdKeyPrec :: Int -> FdKey -> Builder showbFdKeyPrec = showbPrec {-# INLINE showbFdKeyPrec #-} # if MIN_VERSION_base(4,8,1) -- | Convert a 'Lifetime' to a 'Builder'. -- This function is only available with @base-4.8.1.0@ or later and is not available -- on Windows. -- -- /Since: 2/ showbLifetime :: Lifetime -> Builder showbLifetime = showb {-# INLINE showbLifetime #-} # endif instance TextShow Event where showb = showbEvent {-# INLINE showb #-} $(deriveTextShow fdKeyTypeName) instance TextShow $(conT uniqueTypeName) where showb = showb . $(varE asInt64ValName) INLINE_INST_FUN(showb) # if MIN_VERSION_base(4,8,1) $(deriveTextShow ''Lifetime) # endif #endif text-show-2.1.1/src/TextShow/GHC/Stats.hs0000644000000000000000000000207612575552406016272 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,5,0) {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #endif {-| Module: TextShow.GHC.Stats Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' function for 'GCStats'. This module only exports functions if using @base-4.5.0.0@ or later. /Since: 2/ -} module TextShow.GHC.Stats ( #if !(MIN_VERSION_base(4,5,0)) ) where #else showbGCStatsPrec ) where import Data.Text.Lazy.Builder (Builder) import GHC.Stats (GCStats) import TextShow.Classes (showbPrec) import TextShow.Data.Integral () import TextShow.Data.Floating () import TextShow.TH.Internal (deriveTextShow) -- | Convert a 'GCStats' value to a 'Builder' with the given precedence. -- This function is only available with @base-4.5.0.0@ or later. -- -- /Since: 2/ showbGCStatsPrec :: Int -> GCStats -> Builder showbGCStatsPrec = showbPrec {-# INLINE showbGCStatsPrec #-} $(deriveTextShow ''GCStats) #endif text-show-2.1.1/src/TextShow/GHC/Generics.hs0000644000000000000000000001441712575552406016735 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.GHC.Generics Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' functions for generics-related data types. /Since: 2/ -} module TextShow.GHC.Generics ( showbU1 , showbPar1PrecWith , showbRec1Prec , showbRec1PrecWith , showbK1PrecWith , showbM1Prec , showbM1PrecWith , showbSumTypePrec , showbSumTypePrecWith , showbProductTypePrec , showbProductTypePrecWith , showbCompFunctorsPrec , showbCompFunctorsPrecWith , showbFixityPrec , showbAssociativity , showbArityPrec ) where import Data.Text.Lazy.Builder (Builder) import Generics.Deriving.Base (U1(..), Par1, Rec1(..), K1(..), M1(..), (:+:)(..), (:*:)(..), (:.:)(..), Fixity, Associativity, Arity) import TextShow.Classes (TextShow(showb, showbPrec), TextShow1(..), TextShow2(..)) import TextShow.Data.Integral () import TextShow.TH.Internal (deriveTextShow, deriveTextShow1, makeShowbPrec, makeShowbPrecWith, makeShowbPrecWith2) -- | Convert a 'U1' value to a 'Builder'. -- -- /Since: 2/ showbU1 :: U1 p -> Builder showbU1 = showb {-# INLINE showbU1 #-} -- | Convert a 'Par1' value to a 'Builder' with the given show function and precedence. -- -- /Since: 2/ showbPar1PrecWith :: (Int -> p -> Builder) -> Int -> Par1 p -> Builder showbPar1PrecWith = showbPrecWith {-# INLINE showbPar1PrecWith #-} -- | Convert a 'Rec1' value to a 'Builder' with the given precedence. -- -- /Since: 2/ showbRec1Prec :: TextShow (f p) => Int -> Rec1 f p -> Builder showbRec1Prec = showbPrec {-# INLINE showbRec1Prec #-} -- | Convert a 'Rec1' value to a 'Builder' with the given show function and precedence. -- -- /Since: 2/ showbRec1PrecWith :: TextShow1 f => (Int -> p -> Builder) -> Int -> Rec1 f p -> Builder showbRec1PrecWith = showbPrecWith {-# INLINE showbRec1PrecWith #-} -- | Convert a 'K1' value to a 'Builder' with the given show function and precedence. -- -- /Since: 2/ showbK1PrecWith :: (Int -> c -> Builder) -> Int -> K1 i c p -> Builder showbK1PrecWith sp = showbPrecWith2 sp undefined {-# INLINE showbK1PrecWith #-} -- | Convert an 'M1' value to a 'Builder' with the given precedence. -- -- /Since: 2/ showbM1Prec :: TextShow (f p) => Int -> M1 i c f p -> Builder showbM1Prec = showbPrec {-# INLINE showbM1Prec #-} -- | Convert an 'M1' value to a 'Builder' with the given show function and precedence. -- -- /Since: 2/ showbM1PrecWith :: TextShow1 f => (Int -> p -> Builder) -> Int -> M1 i c f p -> Builder showbM1PrecWith = showbPrecWith {-# INLINE showbM1PrecWith #-} -- | Convert a '(:+:)' value to a 'Builder' with the given precedence. -- -- /Since: 2/ showbSumTypePrec :: (TextShow (f p), TextShow (g p)) => Int -> (f :+: g) p -> Builder showbSumTypePrec = showbPrec {-# INLINE showbSumTypePrec #-} -- | Convert a '(:+:)' value to a 'Builder' with the given show function and precedence. -- -- /Since: 2/ showbSumTypePrecWith :: (TextShow1 f, TextShow1 g) => (Int -> p -> Builder) -> Int -> (f :+: g) p -> Builder showbSumTypePrecWith = showbPrecWith {-# INLINE showbSumTypePrecWith #-} -- | Convert a '(:*:)' value to a 'Builder' with the given precedence. -- -- /Since: 2/ showbProductTypePrec :: (TextShow (f p), TextShow (g p)) => Int -> (f :*: g) p -> Builder showbProductTypePrec = showbPrec {-# INLINE showbProductTypePrec #-} -- | Convert a '(:*:)' value to a 'Builder' with the given show function and precedence. -- -- /Since: 2/ showbProductTypePrecWith :: (TextShow1 f, TextShow1 g) => (Int -> p -> Builder) -> Int -> (f :*: g) p -> Builder showbProductTypePrecWith = showbPrecWith {-# INLINE showbProductTypePrecWith #-} -- | Convert a '(:.:)' value to a 'Builder' with the given precedence. -- -- /Since: 2/ showbCompFunctorsPrec :: TextShow (f (g p)) => Int -> (f :.: g) p -> Builder showbCompFunctorsPrec = showbPrec {-# INLINE showbCompFunctorsPrec #-} -- | Convert a '(:.:)' value to a 'Builder' with the given show function and precedence. -- This function is only available with @base-4.4.0.0@ or later. -- -- /Since: 2/ showbCompFunctorsPrecWith :: (TextShow1 f, TextShow1 g) => (Int -> p -> Builder) -> Int -> (f :.: g) p -> Builder showbCompFunctorsPrecWith = showbPrecWith {-# INLINE showbCompFunctorsPrecWith #-} -- | Convert a 'Fixity' value to a 'Builder' with the given precedence. -- -- /Since: 2/ showbFixityPrec :: Int -> Fixity -> Builder showbFixityPrec = showbPrec {-# INLINE showbFixityPrec #-} -- | Convert an 'Associativity' value to a 'Builder'. -- This function is only available with @base-4.4.0.0@ or later. -- -- /Since: 2/ showbAssociativity :: Associativity -> Builder showbAssociativity = showb {-# INLINE showbAssociativity #-} -- | Convert an 'Arity' value to a 'Builder' with the given precedence. -- -- /Since: 2/ showbArityPrec :: Int -> Arity -> Builder showbArityPrec = showbPrec {-# INLINE showbArityPrec #-} instance TextShow (U1 p) where showbPrec = showbPrecWith undefined $(deriveTextShow1 ''U1) $(deriveTextShow ''Par1) $(deriveTextShow1 ''Par1) instance TextShow (f p) => TextShow (Rec1 f p) where showbPrec = $(makeShowbPrec ''Rec1) $(deriveTextShow1 ''Rec1) instance TextShow c => TextShow (K1 i c p) where showbPrec = showbPrecWith undefined instance TextShow c => TextShow1 (K1 i c) where showbPrecWith = showbPrecWith2 showbPrec instance TextShow2 (K1 i) where showbPrecWith2 = $(makeShowbPrecWith2 ''K1) instance TextShow (f p) => TextShow (M1 i c f p) where showbPrec = $(makeShowbPrec ''M1) instance TextShow1 f => TextShow1 (M1 i c f) where showbPrecWith = $(makeShowbPrecWith ''M1) instance (TextShow (f p), TextShow (g p)) => TextShow ((f :+: g) p) where showbPrec = $(makeShowbPrec ''(:+:)) $(deriveTextShow1 ''(:+:)) instance (TextShow (f p), TextShow (g p)) => TextShow ((f :*: g) p) where showbPrec = $(makeShowbPrec ''(:*:)) $(deriveTextShow1 ''(:*:)) instance TextShow (f (g p)) => TextShow ((f :.: g) p) where showbPrec = $(makeShowbPrec ''(:.:)) $(deriveTextShow1 ''(:.:)) $(deriveTextShow ''Fixity) $(deriveTextShow ''Associativity) $(deriveTextShow ''Arity) text-show-2.1.1/src/TextShow/GHC/StaticPtr.hs0000644000000000000000000000231012575552406017100 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-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' function for 'StaticPtrInfo' values. This module only exports functions if using @base-4.8.0.0@ or later. /Since: 2/ -} module TextShow.GHC.StaticPtr ( #if !(MIN_VERSION_base(4,8,0)) ) where #else showbStaticPtrInfoPrec ) where import Data.Text.Lazy.Builder (Builder) import GHC.StaticPtr (StaticPtrInfo) import TextShow.Classes (showbPrec) import TextShow.Data.Char () import TextShow.Data.Integral () import TextShow.Data.List () import TextShow.Data.Tuple () import TextShow.TH.Internal (deriveTextShow) -- | Conver a 'StaticPtrInfo' value to a 'Builder' with the given precedence. -- This function is only available with @base-4.8.0.0@ or later. -- -- /Since: 2/ showbStaticPtrInfoPrec :: Int -> StaticPtrInfo -> Builder showbStaticPtrInfoPrec = showbPrec {-# INLINE showbStaticPtrInfoPrec #-} $(deriveTextShow ''StaticPtrInfo) #endif text-show-2.1.1/src/TextShow/GHC/TypeLits.hs0000644000000000000000000000667512575552406016762 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-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' functions for data types in the @GHC.TypeLits@ module. This module only exports functions if using @base-4.6.0.0@ or later. /Since: 2/ -} module TextShow.GHC.TypeLits ( #if MIN_VERSION_base(4,7,0) showbSomeNatPrec , showbSomeSymbol ) where #elif MIN_VERSION_base(4,6,0) showbIsEven , showbIsZero , showbSingPrec ) where #else ) where #endif #if MIN_VERSION_base(4,6,0) import Data.Text.Lazy.Builder (Builder) import TextShow.Classes (TextShow(showb, showbPrec)) # if MIN_VERSION_base(4,7,0) import GHC.TypeLits (SomeNat(..), SomeSymbol(..), natVal, symbolVal) import TextShow.Data.Char (showbString) import TextShow.Data.Integral (showbIntegerPrec) # else import Data.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (singleton) import GHC.TypeLits (IsEven(..), IsZero(..), Kind, Sing, SingE(fromSing)) import TextShow.Data.Integral () # endif # if MIN_VERSION_base(4,7,0) -- | Convert a 'SomeNat' value to a 'Builder' with the given precedence. -- This function is only available with @base-4.7.0.0@ or later. -- -- /Since: 2/ showbSomeNatPrec :: Int -> SomeNat -> Builder showbSomeNatPrec p (SomeNat x) = showbIntegerPrec p $ natVal x {-# INLINE showbSomeNatPrec #-} -- | Convert a 'SomeSymbol' value to a 'Builder' with the given precedence. -- This function is only available with @base-4.7.0.0@ or later. -- -- /Since: 2/ showbSomeSymbol :: SomeSymbol -> Builder showbSomeSymbol (SomeSymbol x) = showbString $ symbolVal x {-# INLINE showbSomeSymbol #-} # else -- | Convert an 'IsEven' value to a 'Builder'. -- This function is only available with @base-4.6@. -- -- /Since: 2/ showbIsEven :: IsEven n -> Builder showbIsEven IsEvenZero = singleton '0' showbIsEven (IsEven x) = "(2 * " <> showb x <> singleton ')' showbIsEven (IsOdd x) = "(2 * " <> showb x <> " + 1)" {-# INLINE showbIsEven #-} -- | Convert an 'IsZero' value to a 'Builder'. -- This function is only available with @base-4.6@. -- -- /Since: 2/ showbIsZero :: IsZero n -> Builder showbIsZero IsZero = singleton '0' showbIsZero (IsSucc n) = singleton '(' <> showb n <> " + 1)" {-# INLINE showbIsZero #-} -- | Convert a 'Sing' value to a 'Builder' with the given precedence. -- -- /Since: 2/ showbSingPrec :: (SingE (Kind :: k) rep, TextShow rep) => Int -> Sing (a :: k) -> Builder showbSingPrec p = showbPrec p . fromSing {-# INLINE showbSingPrec #-} # endif # if MIN_VERSION_base(4,7,0) instance TextShow SomeNat where showbPrec = showbSomeNatPrec {-# INLINE showbPrec #-} instance TextShow SomeSymbol where showb = showbSomeSymbol {-# INLINE showb #-} # else instance TextShow (IsEven n) where showb = showbIsEven {-# INLINE showb #-} instance TextShow (IsZero n) where showb = showbIsZero {-# INLINE showb #-} instance (SingE (Kind :: k) rep, TextShow rep) => TextShow (Sing (a :: k)) where showbPrec = showbSingPrec {-# INLINE showbPrec #-} # endif #endif text-show-2.1.1/src/TextShow/GHC/Fingerprint.hs0000644000000000000000000000245112575552406017460 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,4,0) {-# OPTIONS_GHC -fno-warn-orphans #-} #endif {-| Module: TextShow.GHC.Fingerprint Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' function for 'Fingerprint' values. This module only exports functions if using @base-4.4.0.0@ or later. /Since: 2/ -} module TextShow.GHC.Fingerprint ( #if !(MIN_VERSION_base(4,4,0)) ) where #else showbFingerprint ) where import Data.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (Builder, singleton) import Data.Word (Word64) import GHC.Fingerprint.Type (Fingerprint(..)) import TextShow.Classes (TextShow(showb)) import TextShow.Data.Integral (showbHex) import TextShow.Utils (lengthB, mtimesDefault) -- | Convert a 'Fingerprint' to a 'Builder'. -- This function is only available with @base-4.4.0.0@ or later. -- -- /Since: 2/ showbFingerprint :: Fingerprint -> Builder showbFingerprint (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 instance TextShow Fingerprint where showb = showbFingerprint {-# INLINE showb #-} #endif text-show-2.1.1/src/TextShow/GHC/RTS/0000755000000000000000000000000012575552406015303 5ustar0000000000000000text-show-2.1.1/src/TextShow/GHC/RTS/Flags.hs0000644000000000000000000001225612575552406016701 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-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' functions for data types in the 'GHC.RTS.Flags' module. This module only exports functions if using @base-4.8.0.0@ or later. /Since: 2/ -} module TextShow.GHC.RTS.Flags ( #if !(MIN_VERSION_base(4,8,0)) ) where #else showbRTSFlagsPrec , showbGCFlagsPrec , showbConcFlagsPrec , showbMiscFlagsPrec , showbDebugFlagsPrec , showbCCFlagsPrec , showbProfFlagsPrec , showbTraceFlagsPrec , showbTickyFlagsPrec # if MIN_VERSION_base(4,8,2) , showbGiveGCStats , showbDoCostCentres , showbDoHeapProfile , showbDoTrace # endif ) where import Data.Text.Lazy.Builder (Builder) import GHC.RTS.Flags import TextShow.Classes (TextShow(showbPrec)) # if MIN_VERSION_base(4,8,2) import TextShow.Classes (showb) # endif 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) -- | Convert an 'RTSFlags' value to a 'Builder' with the given precedence. -- This function is only available with @base-4.8.0.0@ or later. -- -- /Since: 2/ showbRTSFlagsPrec :: Int -> RTSFlags -> Builder showbRTSFlagsPrec = showbPrec {-# INLINE showbRTSFlagsPrec #-} -- | Convert a 'GCFlags' value to a 'Builder' with the given precedence. -- This function is only available with @base-4.8.0.0@ or later. -- -- /Since: 2/ showbGCFlagsPrec :: Int -> GCFlags -> Builder showbGCFlagsPrec = showbPrec {-# INLINE showbGCFlagsPrec #-} -- | Convert a 'ConcFlags' value to a 'Builder' with the given precedence. -- This function is only available with @base-4.8.0.0@ or later. -- -- /Since: 2/ showbConcFlagsPrec :: Int -> ConcFlags -> Builder showbConcFlagsPrec = showbPrec {-# INLINE showbConcFlagsPrec #-} -- | Convert a 'MiscFlags' value to a 'Builder' with the given precedence. -- This function is only available with @base-4.8.0.0@ or later. -- -- /Since: 2/ showbMiscFlagsPrec :: Int -> MiscFlags -> Builder showbMiscFlagsPrec = showbPrec {-# INLINE showbMiscFlagsPrec #-} -- | Convert a 'DebugFlags' value to a 'Builder' with the given precedence. -- -- /Since: 2/ showbDebugFlagsPrec :: Int -> DebugFlags -> Builder showbDebugFlagsPrec = showbPrec {-# INLINE showbDebugFlagsPrec #-} -- | Convert a 'CCFlags' value to a 'Builder' with the given precedence. -- This function is only available with @base-4.8.0.0@ or later. -- -- /Since: 2/ showbCCFlagsPrec :: Int -> CCFlags -> Builder showbCCFlagsPrec = showbPrec {-# INLINE showbCCFlagsPrec #-} -- | Convert a 'ProfFlags' value to a 'Builder' with the given precedence. -- This function is only available with @base-4.8.0.0@ or later. -- -- /Since: 2/ showbProfFlagsPrec :: Int -> ProfFlags -> Builder showbProfFlagsPrec = showbPrec {-# INLINE showbProfFlagsPrec #-} -- | Convert a 'TraceFlags' value to a 'Builder' with the given precedence. -- This function is only available with @base-4.8.0.0@ or later. -- -- /Since: 2/ showbTraceFlagsPrec :: Int -> TraceFlags -> Builder showbTraceFlagsPrec = showbPrec {-# INLINE showbTraceFlagsPrec #-} -- | Convert a 'TickyFlags' value to a 'Builder' with the given precedence. -- This function is only available with @base-4.8.0.0@ or later. -- -- /Since: 2/ showbTickyFlagsPrec :: Int -> TickyFlags -> Builder showbTickyFlagsPrec = showbPrec {-# INLINE showbTickyFlagsPrec #-} # if MIN_VERSION_base(4,8,2) -- | Convert a 'GiveGCStats' value to a 'Builder'. -- This function is only available with @base-4.8.2.0@ or later. -- -- /Since: 2.1/ showbGiveGCStats :: GiveGCStats -> Builder showbGiveGCStats = showb {-# INLINE showbGiveGCStats #-} -- | Convert a 'DoCostCentres' value to a 'Builder'. -- This function is only available with @base-4.8.2.0@ or later. -- -- /Since: 2.1/ showbDoCostCentres :: DoCostCentres -> Builder showbDoCostCentres = showb {-# INLINE showbDoCostCentres #-} -- | Convert a 'DoHeapProfile' value to a 'Builder'. -- This function is only available with @base-4.8.2.0@ or later. -- -- /Since: 2.1/ showbDoHeapProfile :: DoHeapProfile -> Builder showbDoHeapProfile = showb {-# INLINE showbDoHeapProfile #-} -- | Convert a 'DoTrace' value to a 'Builder'. -- This function is only available with @base-4.8.2.0@ or later. -- -- /Since: 2.1/ showbDoTrace :: DoTrace -> Builder showbDoTrace = showb {-# INLINE showbDoTrace #-} # endif $(deriveTextShow ''RTSFlags) $(deriveTextShow ''GCFlags) $(deriveTextShow ''ConcFlags) $(deriveTextShow ''MiscFlags) $(deriveTextShow ''DebugFlags) $(deriveTextShow ''CCFlags) $(deriveTextShow ''ProfFlags) $(deriveTextShow ''TraceFlags) $(deriveTextShow ''TickyFlags) $(deriveTextShow giveGCStatsTypeName) $(deriveTextShow doCostCentresTypeName) $(deriveTextShow doHeapProfileTypeName) $(deriveTextShow doTraceTypeName) #endif text-show-2.1.1/src/TextShow/GHC/Conc/0000755000000000000000000000000012575552406015515 5ustar0000000000000000text-show-2.1.1/src/TextShow/GHC/Conc/Windows.hs0000644000000000000000000000176012575552406017507 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-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' function for 'ConsoleEvent'. This module only exports functions if using Windows, and not using GHCJS. /Since: 2/ -} module TextShow.GHC.Conc.Windows ( #if defined(__GHCJS__) || !defined(mingw32_HOST_OS) ) where #else showbConsoleEvent ) where import Data.Text.Lazy.Builder (Builder) import GHC.Conc.Windows (ConsoleEvent) import TextShow.Classes (showb) import TextShow.TH.Internal (deriveTextShow) -- | Convert a 'ConsoleEvent' to a 'Builder'. -- -- /Since: 2/ showbConsoleEvent :: ConsoleEvent -> Builder showbConsoleEvent = showb {-# INLINE showbConsoleEvent #-} $(deriveTextShow ''ConsoleEvent) #endif text-show-2.1.1/src/TextShow/Text/0000755000000000000000000000000012575552406015156 5ustar0000000000000000text-show-2.1.1/src/TextShow/Text/Read.hs0000644000000000000000000000305612575552406016371 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Text.Read Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' function for 'Lexeme' (and 'Number', if using a recent-enough version of @base@). /Since: 2/ -} module TextShow.Text.Read ( showbLexemePrec #if MIN_VERSION_base(4,7,0) , showbNumberPrec #endif ) where import Data.Text.Lazy.Builder (Builder) import Text.Read.Lex (Lexeme) #if MIN_VERSION_base(4,7,0) import Text.Read.Lex (Number) #endif import TextShow.Classes (showbPrec) 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 #include "inline.h" -- | Convert a 'Lexeme' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbLexemePrec :: Int -> Lexeme -> Builder showbLexemePrec = showbPrec {-# INLINE showbLexemePrec #-} #if MIN_VERSION_base(4,7,0) -- | Convert a 'Number' to a 'Builder' with the given precedence. -- This function is only available with @base-4.7.0.0@ or later. -- -- /Since: 2/ showbNumberPrec :: Int -> Number -> Builder showbNumberPrec = showbPrec {-# INLINE showbNumberPrec #-} #endif $(deriveTextShow ''Lexeme) #if MIN_VERSION_base(4,6,0) $(deriveTextShow numberTypeName) #endif text-show-2.1.1/src/TextShow/Numeric/0000755000000000000000000000000012575552406015634 5ustar0000000000000000text-show-2.1.1/src/TextShow/Numeric/Natural.hs0000644000000000000000000000242512575552406017601 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-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' function for 'Natural's. /Since: 2/ -} module TextShow.Numeric.Natural (showbNaturalPrec) where import Data.Text.Lazy.Builder (Builder) #if MIN_VERSION_base(4,8,0) import GHC.Integer.GMP.Internals (Integer(..)) import GHC.Natural (Natural(..)) import GHC.Types (Word(..)) import TextShow.Data.Integral (showbWord) #else import Numeric.Natural (Natural) #endif import TextShow.Classes (TextShow(showbPrec)) import TextShow.Data.Integral (showbIntegerPrec) #include "inline.h" -- | Convert a 'Natural' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbNaturalPrec :: Int -> Natural -> Builder #if MIN_VERSION_base(4,8,0) showbNaturalPrec _ (NatS# w#) = showbWord $ W# w# showbNaturalPrec p (NatJ# bn) = showbIntegerPrec p $ Jp# bn #else showbNaturalPrec p = showbIntegerPrec p . toInteger {-# INLINE showbNaturalPrec #-} #endif instance TextShow Natural where showbPrec = showbNaturalPrec INLINE_INST_FUN(showbPrec) text-show-2.1.1/src/TextShow/Control/0000755000000000000000000000000012575552406015652 5ustar0000000000000000text-show-2.1.1/src/TextShow/Control/Exception.hs0000644000000000000000000002150012575552406020142 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Control.Exception Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' functions for 'Exception's. /Since: 2/ -} module TextShow.Control.Exception ( showbSomeExceptionPrec , showbIOException , showbArithException , showbArrayException , showbAssertionFailed #if MIN_VERSION_base(4,7,0) , showbSomeAsyncException #endif , showbAsyncException , showbNonTermination , showbNestedAtomically , showbBlockedIndefinitelyOnMVar , showbBlockedIndefinitelyOnSTM #if MIN_VERSION_base(4,8,0) , showbAllocationLimitExceeded #endif , showbDeadlock , showbNoMethodError , showbPatternMatchFail , showbRecConError , showbRecSelError , showbRecUpdError , showbErrorCall , showbMaskingState ) where import Control.Exception.Base import Data.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (Builder, fromString) #if MIN_VERSION_base(4,8,2) import Data.Text.Lazy.Builder (singleton) #endif import Prelude () import Prelude.Compat import TextShow.Classes (TextShow(showb, showbPrec)) import TextShow.FromStringTextShow (FromStringShow(..)) import TextShow.TH.Internal (deriveTextShow) #include "inline.h" -- | Convert a 'SomeException' value to a 'Builder' with the given precedence. -- -- /Since: 2/ showbSomeExceptionPrec :: Int -> SomeException -> Builder showbSomeExceptionPrec p (SomeException e) = showbPrec p $ FromStringShow e {-# INLINE showbSomeExceptionPrec #-} -- | Convert an 'IOException' to a 'Builder'. -- -- /Since: 2/ showbIOException :: IOException -> Builder showbIOException = showb . FromStringShow {-# INLINE showbIOException #-} -- | Convert an 'ArithException' to a 'Builder'. -- -- /Since: 2/ showbArithException :: ArithException -> Builder showbArithException Overflow = "arithmetic overflow" showbArithException Underflow = "arithmetic underflow" showbArithException LossOfPrecision = "loss of precision" showbArithException DivideByZero = "divide by zero" showbArithException Denormal = "denormal" #if MIN_VERSION_base(4,6,0) showbArithException RatioZeroDenominator = "Ratio has zero denominator" #endif -- | Convert an 'ArrayException' to a 'Builder'. -- -- /Since: 2/ showbArrayException :: ArrayException -> Builder showbArrayException (IndexOutOfBounds s) = "array index out of range" <> (if not $ null s then ": " <> fromString s else mempty) showbArrayException (UndefinedElement s) = "undefined array element" <> (if not $ null s then ": " <> fromString s else mempty) {-# INLINE showbArrayException #-} -- | Convert an 'AssertionFailed' exception to a 'Builder'. -- -- /Since: 2/ showbAssertionFailed :: AssertionFailed -> Builder showbAssertionFailed (AssertionFailed err) = fromString err {-# INLINE showbAssertionFailed #-} #if MIN_VERSION_base(4,7,0) -- | Convert a 'SomeAsyncException' value to a 'Builder'. -- This function is only available with @base-4.7.0.0@ or later. -- -- /Since: 2/ showbSomeAsyncException :: SomeAsyncException -> Builder showbSomeAsyncException (SomeAsyncException e) = showb $ FromStringShow e {-# INLINE showbSomeAsyncException #-} #endif -- | Convert an 'AsyncException' to a 'Builder'. -- -- /Since: 2/ showbAsyncException :: AsyncException -> Builder showbAsyncException StackOverflow = "stack overflow" showbAsyncException HeapOverflow = "heap overflow" showbAsyncException ThreadKilled = "thread killed" showbAsyncException UserInterrupt = "user interrupt" {-# INLINE showbAsyncException #-} -- | Convert a 'NonTermination' exception to a 'Builder'. -- -- /Since: 2/ showbNonTermination :: NonTermination -> Builder showbNonTermination NonTermination = "<>" {-# INLINE showbNonTermination #-} -- | Convert a 'NestedAtomically' exception to a 'Builder'. -- -- /Since: 2/ showbNestedAtomically :: NestedAtomically -> Builder showbNestedAtomically NestedAtomically = "Control.Concurrent.STM.atomically was nested" {-# INLINE showbNestedAtomically #-} -- | Convert a 'BlockedIndefinitelyOnMVar' exception to a 'Builder'. -- -- /Since: 2/ showbBlockedIndefinitelyOnMVar :: BlockedIndefinitelyOnMVar -> Builder showbBlockedIndefinitelyOnMVar BlockedIndefinitelyOnMVar = "thread blocked indefinitely in an MVar operation" {-# INLINE showbBlockedIndefinitelyOnMVar #-} -- | Convert a 'BlockedIndefinitelyOnSTM' exception to a 'Builder'. -- -- /Since: 2/ showbBlockedIndefinitelyOnSTM :: BlockedIndefinitelyOnSTM -> Builder showbBlockedIndefinitelyOnSTM BlockedIndefinitelyOnSTM = "thread blocked indefinitely in an STM transaction" {-# INLINE showbBlockedIndefinitelyOnSTM #-} #if MIN_VERSION_base(4,8,0) -- | Convert an 'AllocationLimitExceeded' exception to a 'Builder'. -- This function is only available with @base-4.8.0.0@ or later. -- -- /Since: 2/ showbAllocationLimitExceeded :: AllocationLimitExceeded -> Builder showbAllocationLimitExceeded AllocationLimitExceeded = "allocation limit exceeded" {-# INLINE showbAllocationLimitExceeded #-} #endif -- | Convert a 'Deadlock' exception to a 'Builder'. -- -- /Since: 2/ showbDeadlock :: Deadlock -> Builder showbDeadlock Deadlock = "<>" {-# INLINE showbDeadlock #-} -- | Convert a 'NoMethodError' to a 'Builder'. -- -- /Since: 2/ showbNoMethodError :: NoMethodError -> Builder showbNoMethodError (NoMethodError err) = fromString err {-# INLINE showbNoMethodError #-} -- | Convert a 'PatternMatchFail' to a 'Builder'. -- -- /Since: 2/ showbPatternMatchFail :: PatternMatchFail -> Builder showbPatternMatchFail (PatternMatchFail err) = fromString err {-# INLINE showbPatternMatchFail #-} -- | Convert a 'RecConError' to a 'Builder'. -- -- /Since: 2/ showbRecConError :: RecConError -> Builder showbRecConError (RecConError err) = fromString err {-# INLINE showbRecConError #-} -- | Convert a 'RecSelError' to a 'Builder'. -- -- /Since: 2/ showbRecSelError :: RecSelError -> Builder showbRecSelError (RecSelError err) = fromString err {-# INLINE showbRecSelError #-} -- | Convert a 'RecUpdError' to a 'Builder'. -- -- /Since: 2/ showbRecUpdError :: RecUpdError -> Builder showbRecUpdError (RecUpdError err) = fromString err {-# INLINE showbRecUpdError #-} -- | Convert an 'ErrorCall' to a 'Builder'. -- -- /Since: 2/ showbErrorCall :: ErrorCall -> Builder #if MIN_VERSION_base(4,8,2) showbErrorCall (ErrorCallWithLocation err "") = fromString err showbErrorCall (ErrorCallWithLocation err loc) = fromString err <> singleton '\n' <> fromString loc #else showbErrorCall (ErrorCall err) = fromString err {-# INLINE showbErrorCall #-} #endif -- | Convert a 'MaskingState' to a 'Builder'. -- -- /Since: 2/ showbMaskingState :: MaskingState -> Builder showbMaskingState = showb {-# INLINE showbMaskingState #-} instance TextShow SomeException where showbPrec = showbSomeExceptionPrec INLINE_INST_FUN(showbPrec) instance TextShow IOException where showb = showbIOException INLINE_INST_FUN(showb) instance TextShow ArithException where showb = showbArithException INLINE_INST_FUN(showb) instance TextShow ArrayException where showb = showbArrayException INLINE_INST_FUN(showb) instance TextShow AssertionFailed where showb = showbAssertionFailed INLINE_INST_FUN(showb) #if MIN_VERSION_base(4,7,0) instance TextShow SomeAsyncException where showb = showbSomeAsyncException {-# INLINE showb #-} #endif instance TextShow AsyncException where showb = showbAsyncException INLINE_INST_FUN(showb) instance TextShow NonTermination where showb = showbNonTermination INLINE_INST_FUN(showb) instance TextShow NestedAtomically where showb = showbNestedAtomically INLINE_INST_FUN(showb) instance TextShow BlockedIndefinitelyOnMVar where showb = showbBlockedIndefinitelyOnMVar INLINE_INST_FUN(showb) instance TextShow BlockedIndefinitelyOnSTM where showb = showbBlockedIndefinitelyOnSTM INLINE_INST_FUN(showb) #if MIN_VERSION_base(4,8,0) instance TextShow AllocationLimitExceeded where showb = showbAllocationLimitExceeded {-# INLINE showb #-} #endif instance TextShow Deadlock where showb = showbDeadlock INLINE_INST_FUN(showb) instance TextShow NoMethodError where showb = showbNoMethodError INLINE_INST_FUN(showb) instance TextShow PatternMatchFail where showb = showbPatternMatchFail INLINE_INST_FUN(showb) instance TextShow RecConError where showb = showbRecConError INLINE_INST_FUN(showb) instance TextShow RecSelError where showb = showbRecSelError INLINE_INST_FUN(showb) instance TextShow RecUpdError where showb = showbRecUpdError INLINE_INST_FUN(showb) instance TextShow ErrorCall where showb = showbErrorCall INLINE_INST_FUN(showb) $(deriveTextShow ''MaskingState) text-show-2.1.1/src/TextShow/Control/Concurrent.hs0000644000000000000000000000377312575552406020342 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE UnliftedFFITypes #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Control.Concurrent Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' functions for concurrency-related data types. /Since: 2/ -} module TextShow.Control.Concurrent ( showbThreadIdPrec , showbThreadStatusPrec , showbBlockReason ) where import Data.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (Builder, fromString) import Foreign.C.Types import GHC.Conc (BlockReason, ThreadStatus) import GHC.Conc.Sync (ThreadId(..)) import GHC.Prim import TextShow.Classes (TextShow(showb, showbPrec)) import TextShow.Foreign.C.Types (showbCIntPrec) import TextShow.TH.Internal (deriveTextShow) #include "inline.h" -- | Convert a 'ThreadId' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbThreadIdPrec :: Int -> ThreadId -> Builder showbThreadIdPrec p t = fromString "ThreadId " <> showbCIntPrec p (getThreadId t) {-# INLINE showbThreadIdPrec #-} -- 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) -- | Convert a 'ThreadStatus' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbThreadStatusPrec :: Int -> ThreadStatus -> Builder showbThreadStatusPrec = showbPrec {-# INLINE showbThreadStatusPrec #-} -- | Convert a 'BlockReason' to a 'Builder'. -- -- /Since: 2/ showbBlockReason :: BlockReason -> Builder showbBlockReason = showb {-# INLINE showbBlockReason #-} instance TextShow ThreadId where showbPrec = showbThreadIdPrec INLINE_INST_FUN(showbPrec) $(deriveTextShow ''ThreadStatus) $(deriveTextShow ''BlockReason) text-show-2.1.1/src/TextShow/Control/Applicative.hs0000644000000000000000000000302612575552406020450 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Control.Applicative Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' functions for 'Const' and 'ZipList'. /Since: 2/ -} module TextShow.Control.Applicative (showbConstPrecWith, showbZipListPrecWith) where import Control.Applicative (Const(..), ZipList) import Data.Text.Lazy.Builder (Builder) import TextShow.Classes (TextShow(showbPrec), TextShow1(..), TextShow2(..), showbUnaryWith) import TextShow.Data.List () import TextShow.TH.Internal (deriveTextShow, deriveTextShow1) -- | Convert a 'Const' value to a 'Builder' with the given show function and precedence. -- -- /Since: 2/ showbConstPrecWith :: (Int -> a -> Builder) -> Int -> Const a b -> Builder showbConstPrecWith sp = showbPrecWith2 sp undefined -- | Convert a 'ZipList' to a 'Builder' with the given show function precedence. -- -- /Since: 2/ showbZipListPrecWith :: (Int -> a -> Builder) -> Int -> ZipList a -> Builder showbZipListPrecWith = showbPrecWith instance TextShow a => TextShow (Const a b) where showbPrec = showbPrecWith undefined instance TextShow a => TextShow1 (Const a) where showbPrecWith = showbPrecWith2 showbPrec instance TextShow2 Const where showbPrecWith2 sp1 _ p (Const x) = showbUnaryWith sp1 "Const" p x $(deriveTextShow ''ZipList) $(deriveTextShow1 ''ZipList) text-show-2.1.1/src/TextShow/Control/Monad/0000755000000000000000000000000012575552406016710 5ustar0000000000000000text-show-2.1.1/src/TextShow/Control/Monad/ST.hs0000644000000000000000000000202312575552406017567 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Control.Monad.ST Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' functions for strict 'ST' values. /Since: 2/ -} module TextShow.Control.Monad.ST (showbST) where import Control.Monad.ST (ST) import Data.Text.Lazy.Builder (Builder) import TextShow.Classes (TextShow(showb), TextShow1(..), TextShow2(..)) #include "inline.h" -- | Convert a strict 'ST' value to a 'Builder'. -- -- /Since: 2/ showbST :: ST s a -> Builder showbST = showb {-# INLINE showbST #-} instance TextShow (ST s a) where showb = showbPrecWith undefined 0 INLINE_INST_FUN(showb) instance TextShow1 (ST s) where showbPrecWith = showbPrecWith2 undefined INLINE_INST_FUN(showbPrecWith) instance TextShow2 ST where showbPrecWith2 _ _ _ _ = "<>" INLINE_INST_FUN(showbPrecWith2) text-show-2.1.1/src/TextShow/Foreign/0000755000000000000000000000000012575552406015623 5ustar0000000000000000text-show-2.1.1/src/TextShow/Foreign/Ptr.hs0000644000000000000000000000622212575552406016726 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Foreign.Ptr Copyright: (C) 2014-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' functions for pointer types used in the Haskell Foreign Function Interface (FFI). /Since: 2/ -} module TextShow.Foreign.Ptr ( showbPtr , showbFunPtr , showbIntPtrPrec , showbWordPtr , showbForeignPtr ) where import Data.Monoid.Compat ((<>)) 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#, unsafeCoerce#) import TextShow.Classes (TextShow(showb, showbPrec), TextShow1(..)) import TextShow.Data.Integral (showbHex, showbIntPrec, showbWord) import TextShow.Utils (lengthB, mtimesDefault) #include "MachDeps.h" #include "inline.h" -- | Convert a 'Ptr' to a 'Builder'. Note that this does not require the parameterized -- type to be an instance of 'Show' itself. -- -- /Since: 2/ showbPtr :: Ptr a -> Builder showbPtr = showb {-# INLINE showbPtr #-} -- | Convert a 'FunPtr' to a 'Builder'. Note that this does not require the -- parameterized type to be an instance of 'Show' itself. -- -- /Since: 2/ showbFunPtr :: FunPtr a -> Builder showbFunPtr = showb {-# INLINE showbFunPtr #-} -- | Convert an 'IntPtr' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbIntPtrPrec :: Int -> IntPtr -> Builder showbIntPtrPrec p ip = showbIntPrec p $ unsafeCoerce# ip -- | Convert a 'WordPtr' to a 'Builder'. -- -- /Since: 2/ showbWordPtr :: WordPtr -> Builder showbWordPtr wp = showbWord $ unsafeCoerce# wp -- | Convert a 'ForeignPtr' to a 'Builder'. Note that this does not require the -- parameterized type to be an instance of 'Show' itself. -- -- /Since: 2/ showbForeignPtr :: ForeignPtr a -> Builder showbForeignPtr = showb {-# INLINE showbForeignPtr #-} instance TextShow (Ptr a) where showbPrec = showbPrecWith undefined INLINE_INST_FUN(showbPrec) instance TextShow1 Ptr where showbPrecWith _ _ (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 instance TextShow (FunPtr a) where showbPrec = showbPrecWith undefined INLINE_INST_FUN(showbPrec) instance TextShow1 FunPtr where showbPrecWith _ _ = showb . castFunPtrToPtr INLINE_INST_FUN(showbPrecWith) instance TextShow IntPtr where showbPrec = showbIntPtrPrec INLINE_INST_FUN(showbPrec) instance TextShow WordPtr where showb = showbWordPtr INLINE_INST_FUN(showb) instance TextShow (ForeignPtr a) where showbPrec = showbPrecWith undefined INLINE_INST_FUN(showbPrec) instance TextShow1 ForeignPtr where showbPrecWith _ _ = showb . unsafeForeignPtrToPtr INLINE_INST_FUN(showbPrecWith) text-show-2.1.1/src/TextShow/Foreign/C/0000755000000000000000000000000012575552406016005 5ustar0000000000000000text-show-2.1.1/src/TextShow/Foreign/C/Types.hs0000644000000000000000000002757212575552406017462 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-2015 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' functions for Haskell newtypes corresponding to C types in the Foreign Function Interface (FFI). /Since: 2/ -} module TextShow.Foreign.C.Types ( showbCCharPrec , showbCSCharPrec , showbCUChar , showbCShortPrec , showbCUShort , showbCIntPrec , showbCUInt , showbCLongPrec , showbCULong , showbCPtrdiffPrec , showbCSize , showbCWcharPrec , showbCSigAtomicPrec , showbCLLongPrec , showbCULLong , showbCIntPtrPrec , showbCUIntPtr , showbCIntMaxPrec , showbCUIntMax , showbCClockPrec , showbCTimePrec #if MIN_VERSION_base(4,4,0) , showbCUSeconds , showbCSUSecondsPrec #endif , showbCFloatPrec , showbCDoublePrec ) where import Data.Text.Lazy.Builder (Builder) import Foreign.C.Types import TextShow.Classes (TextShow(showb, showbPrec)) import TextShow.Data.Floating () import TextShow.Data.Integral () #if !(MIN_VERSION_base(4,5,0)) import Data.Int import Data.Word import Unsafe.Coerce (unsafeCoerce) # include "HsBaseConfig.h" # include "inline.h" #endif -- | Convert a 'CChar' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbCCharPrec :: Int -> CChar -> Builder #if MIN_VERSION_base(4,5,0) showbCCharPrec = showbPrec {-# INLINE showbCCharPrec #-} #else showbCCharPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_CHAR -> Builder) #endif -- | Convert a 'CSChar' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbCSCharPrec :: Int -> CSChar -> Builder #if MIN_VERSION_base(4,5,0) showbCSCharPrec = showbPrec {-# INLINE showbCSCharPrec #-} #else showbCSCharPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_SIGNED_CHAR -> Builder) #endif -- | Convert a 'CUChar' to a 'Builder'. -- -- /Since: 2/ showbCUChar :: CUChar -> Builder #if MIN_VERSION_base(4,5,0) showbCUChar = showb {-# INLINE showbCUChar #-} #else showbCUChar = unsafeCoerce (showb :: HTYPE_UNSIGNED_CHAR -> Builder) #endif -- | Convert a 'CShort' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbCShortPrec :: Int -> CShort -> Builder #if MIN_VERSION_base(4,5,0) showbCShortPrec = showbPrec {-# INLINE showbCShortPrec #-} #else showbCShortPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_SHORT -> Builder) #endif -- | Convert a 'CUShort' to a 'Builder'. -- -- /Since: 2/ showbCUShort :: CUShort -> Builder #if MIN_VERSION_base(4,5,0) showbCUShort = showb {-# INLINE showbCUShort #-} #else showbCUShort = unsafeCoerce (showb :: HTYPE_UNSIGNED_SHORT -> Builder) #endif -- | Convert a 'CInt' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbCIntPrec :: Int -> CInt -> Builder #if MIN_VERSION_base(4,5,0) showbCIntPrec = showbPrec {-# INLINE showbCIntPrec #-} #else showbCIntPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_INT -> Builder) #endif -- | Convert a 'CUInt' to a 'Builder'. -- -- /Since: 2/ showbCUInt :: CUInt -> Builder #if MIN_VERSION_base(4,5,0) showbCUInt = showb {-# INLINE showbCUInt #-} #else showbCUInt = unsafeCoerce (showb :: HTYPE_UNSIGNED_INT -> Builder) #endif -- | Convert a 'CLong' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbCLongPrec :: Int -> CLong -> Builder #if MIN_VERSION_base(4,5,0) showbCLongPrec = showbPrec {-# INLINE showbCLongPrec #-} #else showbCLongPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_LONG -> Builder) #endif -- | Convert a 'CULong' to a 'Builder'. -- -- /Since: 2/ showbCULong :: CULong -> Builder #if MIN_VERSION_base(4,5,0) showbCULong = showb {-# INLINE showbCULong #-} #else showbCULong = unsafeCoerce (showb :: HTYPE_UNSIGNED_LONG -> Builder) #endif -- | Convert a 'CPtrdiff' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbCPtrdiffPrec :: Int -> CPtrdiff -> Builder #if MIN_VERSION_base(4,5,0) showbCPtrdiffPrec = showbPrec {-# INLINE showbCPtrdiffPrec #-} #else showbCPtrdiffPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_PTRDIFF_T -> Builder) #endif -- | Convert a 'CSize' to a 'Builder'. -- -- /Since: 2/ showbCSize :: CSize -> Builder #if MIN_VERSION_base(4,5,0) showbCSize = showb {-# INLINE showbCSize #-} #else showbCSize = unsafeCoerce (showb :: HTYPE_SIZE_T -> Builder) #endif -- | Convert a 'CWchar' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbCWcharPrec :: Int -> CWchar -> Builder #if MIN_VERSION_base(4,5,0) showbCWcharPrec = showbPrec {-# INLINE showbCWcharPrec #-} #else showbCWcharPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_WCHAR_T -> Builder) #endif -- | Convert a 'CSigAtomic' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbCSigAtomicPrec :: Int -> CSigAtomic -> Builder #if MIN_VERSION_base(4,5,0) showbCSigAtomicPrec = showbPrec {-# INLINE showbCSigAtomicPrec #-} #else showbCSigAtomicPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_SIG_ATOMIC_T -> Builder) #endif -- | Convert a 'CLLong' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbCLLongPrec :: Int -> CLLong -> Builder #if MIN_VERSION_base(4,5,0) showbCLLongPrec = showbPrec {-# INLINE showbCLLongPrec #-} #else showbCLLongPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_LONG_LONG -> Builder) #endif -- | Convert a 'CULLong' to a 'Builder'. -- -- /Since: 2/ showbCULLong :: CULLong -> Builder #if MIN_VERSION_base(4,5,0) showbCULLong = showb {-# INLINE showbCULLong #-} #else showbCULLong = unsafeCoerce (showb :: HTYPE_UNSIGNED_LONG_LONG -> Builder) #endif -- | Convert a 'CIntPtr' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbCIntPtrPrec :: Int -> CIntPtr -> Builder #if MIN_VERSION_base(4,5,0) showbCIntPtrPrec = showbPrec {-# INLINE showbCIntPtrPrec #-} #else showbCIntPtrPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_INTPTR_T -> Builder) #endif -- | Convert a 'CUIntPtr' to a 'Builder'. -- -- /Since: 2/ showbCUIntPtr :: CUIntPtr -> Builder #if MIN_VERSION_base(4,5,0) showbCUIntPtr = showb {-# INLINE showbCUIntPtr #-} #else showbCUIntPtr = unsafeCoerce (showb :: HTYPE_UINTPTR_T -> Builder) #endif -- | Convert a 'CIntMax' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbCIntMaxPrec :: Int -> CIntMax -> Builder #if MIN_VERSION_base(4,5,0) showbCIntMaxPrec = showbPrec {-# INLINE showbCIntMaxPrec #-} #else showbCIntMaxPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_INTMAX_T -> Builder) #endif -- | Convert a 'CUIntMax' to a 'Builder'. -- -- /Since: 2/ showbCUIntMax :: CUIntMax -> Builder #if MIN_VERSION_base(4,5,0) showbCUIntMax = showb {-# INLINE showbCUIntMax #-} #else showbCUIntMax = unsafeCoerce (showb :: HTYPE_UINTMAX_T -> Builder) #endif -- | Convert a 'CClock' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbCClockPrec :: Int -> CClock -> Builder #if MIN_VERSION_base(4,5,0) showbCClockPrec = showbPrec {-# INLINE showbCClockPrec #-} #else showbCClockPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_CLOCK_T -> Builder) #endif -- | Convert a 'CTime' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbCTimePrec :: Int -> CTime -> Builder #if MIN_VERSION_base(4,5,0) showbCTimePrec = showbPrec {-# INLINE showbCTimePrec #-} #else showbCTimePrec = unsafeCoerce (showbPrec :: Int -> HTYPE_TIME_T -> Builder) #endif #if MIN_VERSION_base(4,4,0) -- | Convert a 'CUSeconds' value to a 'Builder'. -- This function is only available with @base-4.4.0.0@ or later. -- -- /Since: 2/ showbCUSeconds :: CUSeconds -> Builder # if MIN_VERSION_base(4,5,0) showbCUSeconds = showb {-# INLINE showbCUSeconds #-} # else showbCUSeconds = unsafeCoerce (showb :: HTYPE_USECONDS_T -> Builder) # endif -- | Convert a 'CSUSeconds' value to a 'Builder' with the given precedence. -- This function is only available with @base-4.4.0.0@ or later. -- -- /Since: 2/ showbCSUSecondsPrec :: Int -> CSUSeconds -> Builder # if MIN_VERSION_base(4,5,0) showbCSUSecondsPrec = showbPrec {-# INLINE showbCSUSecondsPrec #-} # else showbCSUSecondsPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_SUSECONDS_T -> Builder) # endif #endif -- | Convert a 'CFloat' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbCFloatPrec :: Int -> CFloat -> Builder #if MIN_VERSION_base(4,5,0) showbCFloatPrec = showbPrec {-# INLINE showbCFloatPrec #-} #else showbCFloatPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_FLOAT -> Builder) #endif -- | Convert a 'CDouble' to a 'Builder' with the given precedence. -- -- /Since: 2/ showbCDoublePrec :: Int -> CDouble -> Builder #if MIN_VERSION_base(4,5,0) showbCDoublePrec = showbPrec {-# INLINE showbCDoublePrec #-} #else showbCDoublePrec = unsafeCoerce (showbPrec :: Int -> HTYPE_DOUBLE -> Builder) #endif #if MIN_VERSION_base(4,5,0) deriving instance TextShow CChar deriving instance TextShow CSChar deriving instance TextShow CUChar deriving instance TextShow CShort deriving instance TextShow CUShort deriving instance TextShow CInt deriving instance TextShow CUInt deriving instance TextShow CLong deriving instance TextShow CULong deriving instance TextShow CPtrdiff deriving instance TextShow CSize deriving instance TextShow CWchar deriving instance TextShow CSigAtomic deriving instance TextShow CLLong deriving instance TextShow CULLong deriving instance TextShow CIntPtr deriving instance TextShow CUIntPtr deriving instance TextShow CIntMax deriving instance TextShow CUIntMax deriving instance TextShow CClock deriving instance TextShow CTime # if MIN_VERSION_base(4,4,0) deriving instance TextShow CUSeconds deriving instance TextShow CSUSeconds # endif deriving instance TextShow CFloat deriving instance TextShow CDouble #else instance TextShow CChar where showbPrec = showbCCharPrec INLINE_INST_FUN(showbPrec) instance TextShow CSChar where showbPrec = showbCSCharPrec INLINE_INST_FUN(showbPrec) instance TextShow CUChar where showb = showbCUChar INLINE_INST_FUN(showb) instance TextShow CShort where showbPrec = showbCShortPrec INLINE_INST_FUN(showbPrec) instance TextShow CUShort where showb = showbCUShort INLINE_INST_FUN(showb) instance TextShow CInt where showbPrec = showbCIntPrec INLINE_INST_FUN(showbPrec) instance TextShow CUInt where showb = showbCUInt INLINE_INST_FUN(showb) instance TextShow CLong where showbPrec = showbCLongPrec INLINE_INST_FUN(showbPrec) instance TextShow CULong where showb = showbCULong INLINE_INST_FUN(showb) instance TextShow CPtrdiff where showbPrec = showbCPtrdiffPrec INLINE_INST_FUN(showbPrec) instance TextShow CSize where showb = showbCSize INLINE_INST_FUN(showb) instance TextShow CWchar where showbPrec = showbCWcharPrec INLINE_INST_FUN(showbPrec) instance TextShow CSigAtomic where showbPrec = showbCSigAtomicPrec INLINE_INST_FUN(showbPrec) instance TextShow CLLong where showbPrec = showbCLLongPrec INLINE_INST_FUN(showbPrec) instance TextShow CULLong where showb = showbCULLong INLINE_INST_FUN(showb) instance TextShow CIntPtr where showbPrec = showbCIntPtrPrec INLINE_INST_FUN(showbPrec) instance TextShow CUIntPtr where showb = showbCUIntPtr INLINE_INST_FUN(showb) instance TextShow CIntMax where showbPrec = showbCIntMaxPrec INLINE_INST_FUN(showbPrec) instance TextShow CUIntMax where showb = showbCUIntMax INLINE_INST_FUN(showb) instance TextShow CClock where showbPrec = showbCClockPrec INLINE_INST_FUN(showbPrec) instance TextShow CTime where showbPrec = showbCTimePrec INLINE_INST_FUN(showbPrec) # if MIN_VERSION_base(4,4,0) instance TextShow CUSeconds where showb = showbCUSeconds INLINE_INST_FUN(showb) instance TextShow CSUSeconds where showbPrec = showbCSUSecondsPrec INLINE_INST_FUN(showbPrec) # endif instance TextShow CFloat where showbPrec = showbCFloatPrec INLINE_INST_FUN(showbPrec) instance TextShow CDouble where showbPrec = showbCDoublePrec INLINE_INST_FUN(showbPrec) #endif