text-show-3.4/0000755000000000000000000000000012756060603011515 5ustar0000000000000000text-show-3.4/text-show.cabal0000644000000000000000000005007512756060603014452 0ustar0000000000000000name: text-show version: 3.4 synopsis: Efficient conversion of values into Text description: @text-show@ offers a replacement for the @Show@ typeclass intended for use with @Text@ instead of @String@s. This package was created in the spirit of @@. . At the moment, @text-show@ provides instances for most data types in the @@, @@, @@, and @@ packages. Therefore, much of the source code for @text-show@ consists of borrowed code from those packages in order to ensure that the behaviors of @Show@ and @TextShow@ coincide. . For most uses, simply importing "TextShow" will suffice: . @ module Main where . import TextShow . main :: IO () main = printT (Just \"Hello, World!\") @ . If you desire it, there are also monomorphic versions of the @showb@ function available in the submodules of "TextShow". See the page for more information. . Support for automatically deriving @TextShow@ instances can be found in the "TextShow.TH" and "TextShow.Generic" modules. homepage: https://github.com/RyanGlScott/text-show bug-reports: https://github.com/RyanGlScott/text-show/issues license: BSD3 license-file: LICENSE author: Ryan Scott maintainer: Ryan Scott stability: Provisional copyright: (C) 2014-2016 Ryan Scott category: Text build-type: Simple tested-with: GHC == 7.0.4 , GHC == 7.2.2 , GHC == 7.4.2 , GHC == 7.6.3 , GHC == 7.8.4 , GHC == 7.10.3 , GHC == 8.0.1 extra-source-files: CHANGELOG.md, README.md, include/*.h cabal-version: >=1.10 source-repository head type: git location: https://github.com/RyanGlScott/text-show flag developer description: Operate in developer mode (allows for faster recompilation of tests) default: False manual: True flag base-4-9 description: Use base-4.9 or later. default: True flag template-haskell-2-11 description: Use template-haskell-2.11.0.0 or later. default: True flag new-functor-classes description: Use a version of transformers or transformers-compat with a modern-style Data.Functor.Classes module. This flag cannot be used when building with transformers-0.4, since it comes with a different version of Data.Functor.Classes. default: True library exposed-modules: TextShow TextShow.Control.Applicative TextShow.Control.Concurrent TextShow.Control.Exception TextShow.Control.Monad.ST TextShow.Data.Array TextShow.Data.Bool TextShow.Data.ByteString TextShow.Data.Char TextShow.Data.Complex TextShow.Data.Data TextShow.Data.Dynamic TextShow.Data.Either TextShow.Data.Fixed TextShow.Data.Floating TextShow.Data.Functor.Compose TextShow.Data.Functor.Identity TextShow.Data.Functor.Product TextShow.Data.Functor.Sum TextShow.Debug.Trace TextShow.Debug.Trace.Generic TextShow.Debug.Trace.TH TextShow.Generic TextShow.Data.Integral TextShow.Data.List TextShow.Data.List.NonEmpty TextShow.Data.Maybe TextShow.Data.Monoid TextShow.Data.Ord TextShow.Data.Proxy TextShow.Data.Ratio TextShow.Data.Semigroup TextShow.Data.Text TextShow.Data.Tuple TextShow.Data.Typeable TextShow.Data.Version TextShow.Data.Void TextShow.Foreign.C.Types TextShow.Foreign.Ptr TextShow.Functions TextShow.GHC.Generics TextShow.Numeric.Natural TextShow.System.Exit TextShow.System.IO TextShow.System.Posix.Types TextShow.Text.Read TextShow.TH -- Only exports functions if using Windows TextShow.GHC.Conc.Windows -- Only exports functions if base >= 4.4 TextShow.GHC.Fingerprint -- Only exports functions if base >= 4.4 and not using Windows TextShow.GHC.Event -- Only exports functions if base >= 4.5 TextShow.GHC.Stats -- Only exports functions if base >= 4.6 TextShow.GHC.TypeLits -- Only exports functions if base >= 4.7 TextShow.Data.Type.Coercion TextShow.Data.Type.Equality -- Only exports functions if base >= 4.7 && < 4.8 TextShow.Data.OldTypeable -- Only exports functions if base >= 4.8 TextShow.GHC.RTS.Flags TextShow.GHC.StaticPtr -- Only exports functions if base >= 4.8.1 TextShow.GHC.Stack other-modules: TextShow.Classes TextShow.Data.Typeable.Utils TextShow.FromStringTextShow TextShow.Instances TextShow.Options TextShow.TH.Internal TextShow.TH.Names TextShow.Utils build-depends: array >= 0.3 && < 0.6 , base-compat >= 0.8.1 && < 1 , bifunctors >= 5.1 && < 6 , bytestring >= 0.9 && < 0.11 , bytestring-builder , containers >= 0.1 && < 0.6 , contravariant >= 0.5 && < 2 , generic-deriving >= 1.11 && < 2 , ghc-prim , integer-gmp , nats >= 0.1 && < 2 , semigroups >= 0.17 && < 1 , tagged >= 0.4.4 && < 1 , text >= 0.11.1 && < 1.3 , th-lift >= 0.7.6 && < 1 , void >= 0.5 && < 1 if flag(base-4-9) build-depends: base >= 4.9 && < 5 cpp-options: "-DNEW_FUNCTOR_CLASSES" else build-depends: base >= 4.3 && < 4.9 if flag(template-haskell-2-11) build-depends: template-haskell >= 2.11 && < 2.12 , ghc-boot-th else build-depends: template-haskell >= 2.5 && < 2.11 if flag(new-functor-classes) build-depends: transformers (>= 0.2.1 && < 0.4) || (>= 0.5 && < 0.6) , transformers-compat >= 0.5 && < 1 cpp-options: "-DNEW_FUNCTOR_CLASSES" else build-depends: transformers == 0.4.* hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall include-dirs: include 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.Compose Instances.Data.Functor.Identity Instances.Data.Functor.Product Instances.Data.Functor.Sum Instances.Data.List.NonEmpty Instances.Data.Monoid Instances.Data.Ord Instances.Data.Proxy Instances.Data.Semigroup Instances.Data.Text Instances.Data.Tuple Instances.Data.Typeable Instances.Data.Version Instances.Foreign.C.Types Instances.Foreign.Ptr Instances.FromStringTextShow Instances.Generic Instances.GHC.Generics Instances.Numeric.Natural Instances.Options 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 -- Only exports instances if base >= 4.9 Instances.GHC.Stack Spec.BuilderSpec Spec.Control.ApplicativeSpec Spec.Control.ConcurrentSpec Spec.Control.ExceptionSpec Spec.Control.Monad.STSpec Spec.Data.ArraySpec Spec.Data.BoolSpec Spec.Data.ByteStringSpec Spec.Data.CharSpec Spec.Data.ComplexSpec Spec.Data.DataSpec Spec.Data.DynamicSpec Spec.Data.EitherSpec Spec.Data.FixedSpec Spec.Data.FloatingSpec Spec.Data.Functor.ComposeSpec Spec.Data.Functor.IdentitySpec Spec.Data.Functor.ProductSpec Spec.Data.Functor.SumSpec Spec.Data.IntegralSpec Spec.Data.ListSpec Spec.Data.List.NonEmptySpec Spec.Data.MaybeSpec Spec.Data.MonoidSpec Spec.Data.OrdSpec Spec.Data.ProxySpec Spec.Data.RatioSpec Spec.Data.SemigroupSpec Spec.Data.TextSpec Spec.Data.TupleSpec Spec.Data.TypeableSpec Spec.Data.VersionSpec Spec.Derived.DatatypeContextsSpec Spec.Derived.ExistentialQuantificationSpec Spec.Derived.InfixSpec Spec.Derived.MagicHashSpec Spec.Derived.PolyKindsSpec Spec.Derived.RankNTypesSpec Spec.Derived.RecordsSpec Spec.Derived.TypeSynonymsSpec Spec.Foreign.C.TypesSpec Spec.Foreign.PtrSpec Spec.FromStringTextShowSpec Spec.FunctionsSpec Spec.GenericSpec Spec.GHC.GenericsSpec Spec.Numeric.NaturalSpec Spec.OptionsSpec Spec.System.ExitSpec Spec.System.IOSpec Spec.System.Posix.TypesSpec Spec.Text.ReadSpec Spec.Utils -- Only exports tests if using Windows Spec.GHC.Conc.WindowsSpec -- Only exports tests if base >= 4.4 Spec.GHC.FingerprintSpec -- Only exports tests if base >= 4.4 and not using Windows Spec.GHC.EventSpec -- Only exports tests if base >= 4.5 Spec.GHC.StatsSpec -- Only exports tests if template-haskell >= 2.7 Spec.Derived.DataFamiliesSpec -- Only exports tests if base >= 4.6 Spec.GHC.TypeLitsSpec -- Only exports tests if base >= 4.7 Spec.Data.Type.CoercionSpec Spec.Data.Type.EqualitySpec -- Only exports tests if base >= 4.7 && < 4.8 Spec.Data.OldTypeableSpec -- Only exports tests if base >= 4.8 Spec.GHC.RTS.FlagsSpec Spec.GHC.StaticPtrSpec -- Only exports tests if base >= 4.9 Spec.GHC.StackSpec build-depends: array >= 0.3 && < 0.6 , base-compat >= 0.8.2 && < 1 , base-orphans >= 0.5.2 && < 1 , bifunctors >= 5.1 && < 6 , bytestring >= 0.9 && < 0.11 , bytestring-builder , containers >= 0.1 && < 0.6 , contravariant >= 0.5 && < 2 , deriving-compat >= 0.3 && < 1 , generic-deriving >= 1.11 && < 2 , ghc-prim , hspec >= 2 && < 3 , integer-gmp , nats >= 0.1 && < 2 , QuickCheck >= 2.5 && < 3 , quickcheck-instances >= 0.1 && < 0.4 , semigroups >= 0.17 && < 1 , tagged >= 0.8.3 && < 1 , text >= 0.11.1 && < 1.3 , th-lift >= 0.7.6 && < 1 , transformers-compat >= 0.5 && < 1 , void >= 0.5 && < 1 if flag(base-4-9) build-depends: base >= 4.9 && < 5 cpp-options: "-DNEW_FUNCTOR_CLASSES" else build-depends: base >= 4.3 && < 4.9 if flag(template-haskell-2-11) build-depends: template-haskell >= 2.11 && < 2.12 , ghc-boot-th else build-depends: template-haskell >= 2.5 && < 2.11 if flag(new-functor-classes) build-depends: transformers (>= 0.2.1 && < 0.4) || (>= 0.5 && < 0.6) cpp-options: "-DNEW_FUNCTOR_CLASSES" else build-depends: transformers == 0.4.* if flag(developer) hs-source-dirs: src else build-depends: text-show == 3.4 hs-source-dirs: tests default-language: Haskell2010 ghc-options: -Wall -threaded -rtsopts include-dirs: include includes: generic.h , overlap.h , utils.h benchmark bench -- This SHOULD build with 7.4, but criterion goofed: -- https://github.com/bos/criterion/pull/99 -- -- It should ALSO run with 7.6, but doing so triggers a bug that occurs -- due to GHC 7.6 shipping with an old version of binary: -- https://github.com/bos/criterion/pull/112 if impl(ghc < 7.8) buildable: False type: exitcode-stdio-1.0 main-is: Bench.hs build-depends: array >= 0.3 && < 0.6 , base-compat >= 0.8.1 && < 1 , bifunctors >= 5.1 && < 6 , bytestring >= 0.9 && < 0.11 , bytestring-builder , containers >= 0.1 && < 0.6 , contravariant >= 0.5 && < 2 , criterion >= 1 && < 2 , deepseq >= 1.3 && < 2 , generic-deriving >= 1.11 && < 2 , ghc-prim , integer-gmp , nats >= 0.1 && < 2 , semigroups >= 0.17 && < 1 , tagged >= 0.4.4 && < 1 , text >= 0.11.1 && < 1.3 , th-lift >= 0.7.6 && < 1 , void >= 0.5 && < 1 if flag(base-4-9) build-depends: base >= 4.9 && < 5 cpp-options: "-DNEW_FUNCTOR_CLASSES" else build-depends: base >= 4.5 && < 4.9 if flag(template-haskell-2-11) build-depends: template-haskell >= 2.11 && < 2.12 , ghc-boot-th else build-depends: template-haskell >= 2.5 && < 2.11 if flag(new-functor-classes) build-depends: transformers (>= 0.2.1 && < 0.4) || (>= 0.5 && < 0.6) , transformers-compat >= 0.5 && < 1 cpp-options: "-DNEW_FUNCTOR_CLASSES" else build-depends: transformers == 0.4.* if flag(developer) hs-source-dirs: src else build-depends: text-show == 3.4 hs-source-dirs: benchmarks default-language: Haskell2010 ghc-options: -Wall include-dirs: include includes: inline.h , utils.h text-show-3.4/LICENSE0000644000000000000000000000276312756060603012532 0ustar0000000000000000Copyright (c) 2014-2016, Ryan Scott All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Ryan Scott nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. text-show-3.4/CHANGELOG.md0000644000000000000000000005513312756060603013335 0ustar0000000000000000## 3.4 * The default definitions of `showt` and `showtl` were changed to `showtPrec 0` and `showtlPrec 0`, respectively * `deriveTextShowOptions`, `deriveTextShow1Options`, and `deriveTextShow2Options` added to `TextShow.TH`, which allow further configuration of how `TextShow(1)(2)` instances should be derived using the new `Options` data type. `Options` itself contains `GenTextMethods`, which configures whether manual implementations of `TextShow` should implement the methods that return strict and lazy `Text`. * The `defaultOptions` uses `SometimesTextMethods`, which only implements the `Text`-returning methods if the datatype contains only nullary constructors (i.e., it is an enumeration type). For example, `deriveTextShow = deriveTextShowOptions defaultOptions`. One can also choose `AlwaysTextMethods` or `NeverTextMethods` instead. * The internals of `TextShow.Generic` were refactored so that is possible to generically derive `showbPrec`, `showtPrec`, and `showtlPrec` (which use `Builder`, strict `Text`, and lazy `Text`, respectively). Before, only generic derivation of `showbPrec` was possible, and all other generic functions were defined in terms of `showbPrec`. * The internal class `GTextShow` was split up into `GShowB`, `GShowT`, and `GShowTL`, depending on what type it returns. * As a result, functions like `genericShowtPrec` might be faster than before if they are showing something like an enumeration type, since they no longer construct an intermediate `Builder`. On the other hand, they might be slower if they are showing a constructor with many fields, since they will now be appending lots of `Text`s. If so, make sure to switch to `genericShowbPrec` and convert the final `Builder` to `Text` instead. * Added `showtParen`, `showtSpace`, `showtlParen`, `showtlSpace`, `liftShowtPrec`, `liftShowtPrec2`, `liftShowtlPrec`, and `liftShowtlPrec2` to `TextShow` * Added `showtPrecToShowbPrec`, `showtlPrecToShowbPrec`, `showtToShowb`, `showtlToShowb`, `showbPrecToShowtPrec`, `showbPrecToShowtlPrec`, `showbToShowt`, and `showbToShowtl` to `TextShow` * Added `showtListWith` and `showtlListWith` to `TextShow.Data.List` * Added `Data` instance for `ConType` in `TextShow.Generic` * Require `generic-deriving-1.11` or later ## 3.3 * Refactored the internals of `TextShow.Generic` to avoid the use of proxies. * Made benchmark suite more comprehensive, including benchmarks for showing an enumeration type * Microoptimization in derived `TextShow1/2` instances involving `TextShow.TH` * Allow building with `QuickCheck-2.9` * Fix GHC HEAD build ### 3.2.2 * Added benchmarks ### 3.2.1 * Fixed compilation on GHC 8.0 ## 3.2 * Rewrote `TextShow.Generic` to enable more code reuse. The `GTextShow1` and `GTextShow1Con` classes were eliminated, and `GTextShow` and `GTextShowCon` were redesigned to be able to generically implement both `showbPrec` and `liftShowbPrec`. The latter two classes now take an additional `arity` type parameter which is `Zero` if `TextShow` is being derived and `One` is `TextShow1` is being derived. ## 3.1 * Made the derived `TextShow` output of record datatypes match that of `Show` in GHC 8.0 (now that Trac #2530 has been reverted) * Fixed GHC 8.0 build (again) ### 3.0.1 * Added the `TextShow.GHC.Stack` module, which provides `TextShow` instances for `CallStack` and `SrcLoc` on `base-4.8.1` and up. * Fix Haddock rendering error # 3 * GHC 8.0 support * The functions `showt`, `showtl`, `showtPrec`, `showtlPrec`, `showtList`, and `showtlList` are now part of the `TextShow` class. This was done to allow overriding their definitions with more efficient versions specifically for strict or lazy `Text`. (Currently, no `TextShow` instance in the `text-show` package does this, but this may change in the future.) * Added the `TextShow.Data.Functor.Compose`, `TextShow.Data.Functor.Product`, `TextShow.Data.Functor.Sum`, and `TextShow.Data.Semigroup` modules * Added `TextShow` instance for `TypeError` in `TextShow.Control.Exception` (GHC 8.0+) * Added `TextShow` instances for `TrName` and `Module` in `TextShow.Data.Typeable` (GHC 8.0+) * Added `Lift` instances for the datatypes in `TextShow` and `TextShow.Generic` * Renamed the class methods of `TextShow1` and `TextShow2` to be consistent with the naming conventions of `transformers-0.5`. They following were renamed: * `showbPrecWith` → `liftShowbPrec` * `showbPrecWith2` → `liftShowbPrec2` * `makeShowbPrecWith` → `makeLiftShowbPrec` * `makeShowbPrecWith2` → `makeLiftShowbPrec2` * `genericShowbPrecWith` → `genericLiftShowbPrec` In addition, many other monomorphic functions from the various `TextShow` submodules were also renamed to be consistent with the new `lift-` prefix. * `showsToShowb` and `showbToShows` now only convert functions that ignore precedence (i.e., of type `a -> ShowS` or `a -> Builder`). Their former role has been given to the new functions `showsPrecToShowbPrec` and `showbPrecToShowsPrec` * Added `FromStringShow1`, `FromTextShow1`, `FromStringShow2`, and `FromTextShow2`, which allow defining string `Show1`/`Show2` instances in terms of `TextShow1`/`TextShow2` instances, and vice versa. Be aware that many of these instances cannot be provided if you are using `tranformers-0.4`, since its version of `Data.Functor.Classes` uses a very differenltly designed `Show1` typeclass (and does not have `Show2` at all). * Rewrote `TextShow.TH`'s type inferencer. This avoids a nasty GHC 7.8 bug, and it allows `TextShow(1)(2)` to be derived for more datatypes that can only be expressed with `-XTypeInType` enabled. * Reworked internals of `TextShow.Generic`. Empty datatypes can now be have generic `TextShow` and `TextShow1` instances. # 2.1.2 * Fixed GHC 7.10.3 build * Extended `TextShow.Generic` to allow `genericShowbPrec` (and friends) to be used on `Generic` datatypes with `Char#`, `Double#`, `Float#`, `Int#`, and `Word#` argument types, just like string `Show` does * Added `Generic1` instances for `FromStringShow` and `FromTextShow` * Added `TextShow` instances for `UChar`, `UDouble`, `UFloat`, `UInt`, and `UWord` in `TextShow.GHC.Generics` # 2.1.1 * Restore support for `semigroups-0.16.1` # 2.1 * Require `semigroups` >= 0.17 * Added `showsToShowb` and `showbToShows` to `TextShow` * Added `TextShow1 FromStringShow` instance * Added `showbGiveGCStats`, `showbDoCostCentres`, `showbDoHeapProfile`, and `showbDoTrace` to `TextShow.GHC.RTS.Flags` if using `base-4.8.2` or later * Exported `showbDownPrecWith` on earlier versions of GHC * Fixed mistakes in TH error output * Make `Proxy`, `Coercion`, and `(:~:)` instances poly-kinded * Changed implementation of `showbByteStringStrict`, `showbByteStrictLazy(Prec)`, `showbShortByteString` (in `TextShow.Data.ByteString`), `showbThreadIdPrec` (in `TextShow.Control.Concurrent`), `showbEvent`, and `showbFdKeyPrec` (in `TextShow.GHC.Event`) to avoid using `String`s as an intermediary # 2 * Changed the top-level module name from `Text.Show.Text` to `TextShow`, since the former was extremely verbose without much benefit. As a result, this will break all existing code that depends on `text-show`. * Several typeclasses and functions were renamed so as to not to clash with the `Prelude`: * `Show` → `TextShow` * `Show1` → `TextShow1` * `Show2` → `TextShow2` * `show` → `showt` * `showLazy` → `showtl` * `showPrec` → `showtPrec` * `showPrecLazy` → `showtlPrec` * `showList` → `showtList` * `showListLazy` → `showtlList` * `print` → `printT` * `printLazy` → `printTL` * `hPrint` → `hPrintT` * `hPrintLazy` → `hPrintTL` * `GShow` → `GTextShow` * `GShow1` → `GTextShow1` * `genericShow` → `genericShowt` * `genericShowLazy` → `genericShowtl` * `genericShowPrec` → `genericShowtPrec` * `genericShowPrecLazy` → `genericShowtlPrec` * `genericShowList` → `genericShowtList` * `genericShowListLazy` → `genericShowtlList` * `genericPrint` → `genericPrintT` * `genericPrintLazy` → `genericPrintTL` * `genericHPrint` → `genericHPrintT` * `genericHPrintLazy` → `genericHPrintTL` * `deriveShow` → `deriveTextShow` * `deriveShow1` → `deriveTextShow1` * `deriveShow2` → `deriveTextShow2` * `mkShow` → `makeShowt` * `mkShowLazy` → `makeShowtl` * `mkShowPrec` → `makeShowtPrec` * `mkShowPrecLazy` → `makeShowtlPrec` * `mkShowList` → `makeShowtList` * `mkShowListLazy` → `makeShowtlList` * `mkShowb` → `makeShowb` * `mkShowbPrec` → `makeShowbPrec` * `mkShowbList` → `makeShowbList` * `mkPrint` → `makePrintT` * `mkPrintLazy` → `makePrintTL` * `mkHPrint` → `makeHPrintT` * `mkHPrintLazy` → `makeHPrintTL` * `mkShowbPrecWith` → `makeShowbPrecWith` * `mkShowbPrec1` → `makeShowbPrec1` * `mkShowbPrecWith2` → `makeShowbPrecWith2` * `mkShowbPrec2` → `makeShowbPrec2` * `trace` → `tracet` * `traceLazy` → `tracetl` * `traceId` → `tracetId` * `traceIdLazy` → `tracetlId` * `traceShow` → `traceTextShow` * `traceShowId` → `traceTextShowId` * `traceStack` → `tracetStack` * `traceStackLazy` → `tracetlStack` * `traceIO` → `tracetIO` * `traceIOLazy` → `tracetlIO` * `traceM` → `tracetM` * `traceMLazy` → `tracetlM` * `traceShowM` → `traceTextShowM` * `traceEvent` → `tracetEvent` * `traceEventLazy` → `tracetlEvent` * `traceEventIO` → `travetEventIO` * `traceEventIOLazy` → `tracetlEventIO` * `traceMarker` → `tracetMarker` * `traceMarkerLazy` → `tracetlMarker` * `traceMarkerIO` → `tracetMarkerIO` * `traceMarkerIOLazy` → `tracetlMarkerIO` * `genericTraceShow` → `genericTraceTextShow` * `genericTraceShowId` → `genericTraceTextShowId` * `genericTraceShowM` → `genericTraceTextShowM` * `mkTraceShow` → `makeTraceTextShow` * `mkTraceShowId` → `makeTraceTextShowId` * `mkTraceShowM` → `makeTraceTextShowM` * Added `TextShow Lifetime` instance in `TextShow.GHC.Event` (if using `base-4.8.1.0` or later) * Generalized `tracetM`, `tracetlM`, and `traceTextShowM` to use an `Applicative` constraint instead of `Monad` * Fixed a bug in which the `TextShow(1)` instances for `Proxy`, `(:~:)`, and `Coercion` didn't use `-XPolyKinds` * Fixed a bug in the Template Haskell deriver which would cause `deriveTextShow` to fail on type parameters with sufficiently high kinds # 1 * The `Show1` class has been completely overhauled. `Show1` now uses the function `showbPrecWith`, which takes as an argument a function of type `Int -> a -> Builder` to show occurrences of the type parameter (instead of requiring the type parameter to be a `Show` instance). This matches the new implementation of `Show1` in the next version of `transformers`. A similar `Show2` class (with the function `showbPrecWith2`) was also added. * As a consequence, `Show1` instances should no longer be defined in terms of `showbPrec`; rather, `Show` instances should be defined in terms of `showbPrecWith` or `showbPrecWith2`, and `Show1` instances can be defined in terms of `showbPrecWith2`. * The `showbPrec1` function is no longer a class method of `Show1`, but is now a standalone function defined in terms of `showbPrecWith`. `showbPrec1` can be useful for defining `Show` instances. A similar `showbPrec2` function was also added. * The monomorphic functions in the many submodules of this package have been generalized (where possible) to use `Show1` and `Show2` instances. These functions have `-PrecWith` and `-PrecWith2` suffixes, respectively. * Because of the generality of the new `showPrecWith` function, `Show1` instances are now possible for `Ratio`, `Alt`, `Rec1`, `M1`, `(:+:)`, `(:*:)`, and `(:.:)`. * Removed many silly instances for `FromStringShow` and `FromTextShow`, since they'll never be used in the ways suggested by those instances to begin with. * The Template Haskell engine has been completely overhauled. Deriving `Show1` and `Show2` instances are now possible using the `deriveShow1` and `deriveShow2` functions. See the documentation in `Text.Show.Text.TH` for more details. In addition, the `mkShowbPrecWith`, `mkShowbPrec1`, `mkShowbPrecWith2`, and `mkShowbPrec2` functions were added. * Removed the ability to call `deriveShow` or `mkShowbPrec` (or other functions prefixed with `mk-`) using a data family name. This is considered a misfeature. If you want to derive `Show` for data family instances, use the corresponding `data instance` or `newtype instance` constructor name as an argument instead. * Removed `PragmaOptions`, `deriveShowPragmas`, `defaultInlineShowbPrec`, `defaultInlineShowb`, and `defaultInlineShowbList`, as it was impossible to make Template Haskell-generated pragmas work consistently across different versions of GHC. If you really want to use `INLINE` and `SPECIALIZE instance` pragmas with your Template Haskell-generated code, create manual instances with `mkShowbPrec` and family. * `Show1` instances can now be created generically using the `genericShowbPrecWith` function in `Text.Show.Text.Generics`. A `genericShowbPrec1` was also added. * Added `generic-deriving` as a dependency, which allows generics-related code to be exported on more versions of GHC * `ConType` (in `Text.Show.Text.Generics`) now has an `Inf String` constructor instead of `Inf Builder`. As a result, `ConType` now always an `Eq` and `Ord` instance, and a `Read ConType` instance was added. * `Typeable` instances for the promoted data constructors `'FromStringShow` and `'FromTextShow` * Added `showbFPFormat` to `Text.Show.Text.Data.Floating` * Revamped test suite ### 0.8.1.1 * Retroactive `CHANGELOG` update ## 0.8.1 * Fix test suite build with older versions of `QuickCheck` # 0.8 * Exported `formatRealFloatB` and `formatRealFloatAltB` from `Text.Show.Text.Data.Floating`. Reexported `FPFormat` (from `text`) in the same module, and added a `Text` `Show` instance for it. * The `Show` instance for `Ratio a` now only requires a `Show a` constraint if using `base-4.4.0.0` or later (if using `base-4.3.0.0`, it requires a `(Show a, Integral a)` constraint) * Added `showbSingPrec` to `Text.Show.Text.GHC.TypeLits` (if using `base-4.6`) * Modules which were previously exported only if using a recent-enough version of GHC/`base` (e.g., `Text.Show.Text.GHC.Generics`) are now always exposed. If the functionality that the module provides is not available on a given version of GHC/`base`, the module will not expose anything. * Bump lower version bounds of `text` to 0.11.1 due to reexporting `FPFormat` * Added `showbUnicodeException`, `showbI16Prec`, `showbDecodingPrec`, and `showbSizePrec` functions (and corresponding `Show` instances) to `Text.Show.Text.Data.Text` * Made `GShow` in `Text.Show.Text.Generics` poly-kinded * The Template Haskell deriver (and `GShow`) now handles "infix" data constructors that are applied as prefix correctly (e.g., `data Amp a = (:&) a a`) * The Template Haskell deriver now handles showable unlifted types (`Char#`, `Double#`, `Float#`, `Int#`, and `Word#`) correctly on GHC 7.11 and later * The Template Haskell derive now does not parenthesize record types regardless of precedence on GHC 7.11 and later * Fixed build on GHC 7.2 * Changed test-suite to use `hspec`, which allows for it to be built on GHC 7.0 and 7.2 ### 0.7.0.1 * Disabled `print`-related tests, as they sporadically break referential transparency for unknown reasons * Fixed build on Windows # 0.7 * Added `showbConstPrec` (and corresponding `Show` and `Show1` instances for `Const`) to `Text.Show.Text.Control.Applicative` * Added `showbUArrayPrec` (and corresponding `Show` instance for `UArray`s) and `showbIArrayPrec` to `Text.Data.Text.Data.Array`. * Renamed `showbListDefault` to `showbListWith` to match how `Text.Show` names it * Exposed `showbShortByteString` with all versions of `bytestring` by using the `bytestring-builder` package * Corrected the `Show` instance for `Lexeme` (in `Text.Show.Text.Text.Read.Lex`) * Fixed `TypeRep` output on GHC 7.10 and later * Removed `LitChar` and `LitString` from `Text.Show.Text.Data.Char`, as they were not as useful as I had imagined. * Removed the deprecated `replicateB` function * `Typable` instances for `Show`, `Show1`, and `GShow` (with GHC 7.8 and later) * `Typeable` instance for `ConType` * Only derive `Eq` and `Ord` for `ConType` if a recent-enough version of `text` is used * Changed the implementations of some functions in `Text.Show.Text.Debug.Trace` to use `ByteString`s instead of `String`s ### 0.6.0.1 * Forgot to include some header files in `text-show.cabal` # 0.6 * `deriveShow` can now construct instances for data families, using either the data family name or a data instance constructor as an argument. See the documentation in `Text.Show.Text.TH` for more details. * Fixed a bug in which infix backticked data constructors (e.g., ```data Add = Int `Plus` Int```) would not be shown correctly. * Fixed typo in `Text.Show.Text.GHC.RTS.Flags` * Removed the phantom-type detecting mechanism with `template-haskell-2.9.0.0` or higher. This method of finding phantom types is intrinsically flawed and is not usable on older GHCs. * Added generics support with the `Text.Show.Text.Generic` and `Text.Show.Text.Debug.Trace.Generic` modules * Deprecated `replicateB` in favor of `timesN` from the `semigroups` library * Added `FromTextShow` to `Text.Show.Text`, which admits a `String` `Show` instance for any data type with a `Text` `Show` instance (the counterpart of `FromStringShow`) * Added `Monoid` and `Semigroup` instances for `FromStringShow`, `Semigroup` instance for `LitString`, `IsChar` instance for `LitChar`, and `IsString` instance for `[LitChar]` * Changed the `String` `Show` instances of `FromStringShow`, `LitChar`, and `LitString` to more closely match the `Text` `Show` instances. As a result, the `Read` instances for these data types were also changed so that `read . show = read . show = id`. * Removed the `recent-text` flag. We'll allow users to build with older versions of `text`, but the latest version is recommended. Because of this, the `integer-simple` and `integer-gmp` flags are not needed. * Removed the `integer-gmp2` flag, as it supported a configuration that didn't actually compile on GHC * Removed the `transformers-four` flag, as it is not needed now that `transformers-compat` is a dependency # 0.5 * Fix build for GHC 7.10, old GHC versions, and Windows * Removed the `Text.Show.Text.Data.Containers` and `Text.Show.Text.Data.Time` modules. The modules for the data types in `containers` and `time` were migrated to a separate library, `text-show-instances`. * Removed the `-ftext-format` flag, as `text-show` no longer uses `text-format`. * A [serious bug](https://github.com/bos/text/issues/99) in the `text` package that caused segfaults when building large `Integer`s was fixed in `text-1.2.0.2`. A flag (`-frecent-text`) was added that allows you to take advantage of this. * Fixed a bug that would cause the output of functions in the `Text.Show.Text.Data.Floating` module to not match `base` depending on what version of `base` is used. * The type signatures of lambda expressions generated by `mkShow` and related functions were loosened to allow them to be used to "manually" derive `Show` instances for data types with higher-kinded type parameters or type arguments with restricted `Show` instances. This should not be a breaking change; you can simply do more with `mkShow` et al. than you could before. For more information, see the documentation in `Text.Show.Text.TH`. * Loosened the `Show` instance of `Complex a` to only depend on `Show a` (previously required `RealFloat a`) if using base-4.4.0.0 or later * Moved `showbRatioPrec` to `Text.Show.Text.Data.Ratio`, `showbComplexPrec` to `Text.Show.Text.Data.Complex`, `showbProxy` to `Text.Show.Text.Data.Proxy`, and `showbFingerprint` to `Text.Show.Text.GHC.Fingerprint` * Added `deriveShowPragmas` to `Text.Show.Text.TH` to allow users to specify `INLINE` or `SPECIALIZE instance` pragmas with `Show` instances. * Added `FromStringShow`, `showbSpace`, `showbUnary`, `showbUnary1`, and `showbBinary1` to `Text.Show.Text` * Added `mkShowList`, `mkShowListLazy`, and `mkShowbList` to `Text.Data.Text.TH` * For base-4.8.0.0 and above, added the `Text.Show.Text.Data.Functor.Identity`, `Text.Show.Text.Data.Void`, `Text.Show.Text.GHC.RTS.Flags`, `Text.Show.Text.GHC.StaticPtr`, and `Text.Show.Text.Numeric.Natural` modules. Also added `Show` instances for `AllocationLimitExceeded` in `Text.Show.Text.Control.Exception` and `Alt` in `Text.Show.Text.Data.Monoid`. Also fixed the `Show` instance for `Fixed` values. * Added the `Text.Show.Text.Data.GHC.Conc.Windows` module (Windows-only) * Added the `Text.Show.Text.Data.OldTypeable` module for base-4.7 * Added the `Text.Show.Text.GHC.TypeLits` module for base-4.6 and above * Added the `Text.Show.Text.Debug.Trace` and `Text.Show.Text.Debug.Trace.TH` modules as an analog to `Debug.Trace` * Added the `Show1` class and corresponding instances for unary type constructors. * Added `LitChar` and `LitString` to `Text.Show.Text.Data.Char` * Exported `asciiTabB` in `Text.Show.Text.Data.Char` * Renamed `showbTextStrict` to 'showbText' (to keep with naming conventions in the `text` library) and added `showbBuilder` to `Text.Show.Text.Data.Text`. ## 0.4.1 * Added the utility functions `toText` and `toString` for working with `Builder`s. # 0.4 * Due to [GHC bug #5289](http://ghc.haskell.org/trac/ghc/ticket/5289), projects that depend on the `double-conversion` library (such as `text-format`, a dependency of `text-show`) may break due to GHC incorrectly linking against libstdc++. Therefore, `text-show` was changed so that it does not depend on `text-format` by default. This behavior can be changed by using the `-ftext-format` flag when using `cabal`. * Added `showbZonedTime` to `Text.Show.Text.Data.Time` (and corresponding `Show` instance for `ZonedTime`) * Exposed `showbMaskingState` (is was already there, I just forgot to export it) * If using GHC 7.6 or earlier, depend on tagged so that `Data.Proxy` (and thus `showbProxy` from `Text.Show.Text.Data.Typeable`) can be used * Refactored code to use Template Haskell derivations when possible ## 0.3.1.0 * Added `showList` and `showListLazy` * Don't use `showbListDefault` to show `containers` data types * Added the ability to splice `show` functions for arbitrary data types (even if they aren't `Show` instances). These functions are `mkShow`, `mkShowLazy`, `mkShowPrec`, `mkShowPrecLazy`, `mkShowb`, `mkShowbPrec`, `mkPrint`, `mkPrintLazy`, `mkHPrint`, and `mkHPrintLazy`. # 0.3.0.0 * Lots of bugfixes * `Show` instances for many other data types in `base`, `containers` and `time` * Exposed internal modules with monomorphic functions * `Text.Show.Text` now exports `Data.Text.Lazy.Builder` for convenience * Add `showLazy`, `showPrec`, `showPrecLazy`, `printLazy`, `hPrint`, `hPrintLazy`, `lengthB`, and `replicateB` * Template Haskell derivation of `Show` instances (doesn't support data families yet) # 0.2.0.0 * Added `Show` instances for strict and lazy `Text` # 0.1.0.0 * Initial commit text-show-3.4/README.md0000644000000000000000000000403012756060603012771 0ustar0000000000000000# `text-show` [![Hackage](https://img.shields.io/hackage/v/text-show.svg)][Hackage: text-show] [![Hackage Dependencies](https://img.shields.io/hackage-deps/v/text-show.svg)](http://packdeps.haskellers.com/reverse/text-show) [![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-blue.svg)][Haskell.org] [![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg)][tl;dr Legal: BSD3] [![Build](https://img.shields.io/travis/RyanGlScott/text-show.svg)](https://travis-ci.org/RyanGlScott/text-show) [Hackage: text-show]: http://hackage.haskell.org/package/text-show "text-show package on Hackage" [Haskell.org]: http://www.haskell.org "The Haskell Programming Language" [tl;dr Legal: BSD3]: https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29 "BSD 3-Clause License (Revised)" `text-show` offers a replacement for the `Show` typeclass intended for use with `Text` instead of `String`s. This package was created in the spirit of [`bytestring-show`](http://hackage.haskell.org/package/bytestring-show). At the moment, `text-show` provides instances for most data types in the [`array`](http://hackage.haskell.org/package/array), [`base`](http://hackage.haskell.org/package/base), [`bytestring`](http://hackage.haskell.org/package/bytestring), and [`text`](http://hackage.haskell.org/package/text) packages. Therefore, much of the source code for `text-show` consists of borrowed code from those packages in order to ensure that the behaviors of `Show` and `TextShow` coincide. For most uses, simply importing `TextShow` will suffice: ```haskell module Main where import TextShow main :: IO () main = printT (Just "Hello, World!") ``` If you desire it, there are also monomorphic versions of the `showb` function available in the submodules of `Text.Show.Text`. See the [naming conventions](https://github.com/RyanGlScott/text-show/wiki/Naming-conventions) page for more information. Support for automatically deriving `TextShow` instances can be found in the `TextShow.TH` and `TextShow.Generic` modules. text-show-3.4/Setup.hs0000644000000000000000000000005612756060603013152 0ustar0000000000000000import Distribution.Simple main = defaultMain text-show-3.4/tests/0000755000000000000000000000000012756060603012657 5ustar0000000000000000text-show-3.4/tests/Spec.hs0000644000000000000000000000005412756060603014104 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} text-show-3.4/tests/Derived/0000755000000000000000000000000012756060603014241 5ustar0000000000000000text-show-3.4/tests/Derived/ExistentialQuantification.hs0000644000000000000000000001133212756060603021765 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-| Module: Derived.ExistentialQuantification Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Defines data types with existentially quantified type variables. -} module Derived.ExistentialQuantification (TyCon(..), TyFamily(..)) where import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..), Gen, oneof) import Text.Show.Deriving (deriveShow1) #if defined(NEW_FUNCTOR_CLASSES) import Text.Show.Deriving (deriveShow2) #endif import TextShow (TextShow) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) ------------------------------------------------------------------------------- data TyCon a b c d where TyConClassConstraints :: (Ord m, Ord n, Ord o, Ord p) => m -> n -> o -> p -> TyCon m n o p TyConEqualityConstraints :: (e ~ g, f ~ h, e ~ f) => e -> f -> g -> h -> TyCon e f g h TyConTypeRefinement1, TyConTypeRefinement2 :: Int -> z -> TyCon Int Int z z TyConForalls :: forall p q r s t u. (Arbitrary p, Show p, TextShow p, Arbitrary q, Show q, TextShow q) => p -> q -> u -> t -> TyCon r s t u deriving instance (Show a, Show b, Show c, Show d) => Show (TyCon a b c d) ------------------------------------------------------------------------------- data family TyFamily w x y z :: * data instance TyFamily a b c d where TyFamilyClassConstraints :: (Ord m, Ord n, Ord o, Ord p) => m -> n -> o -> p -> TyFamily m n o p TyFamilyEqualityConstraints :: (e ~ g, f ~ h, e ~ f) => e -> f -> g -> h -> TyFamily e f g h TyFamilyTypeRefinement1, TyFamilyTypeRefinement2 :: Int -> z -> TyFamily Int Int z z TyFamilyForalls :: forall p q r s t u. (Arbitrary p, Show p, TextShow p, Arbitrary q, Show q, TextShow q) => p -> q -> u -> t -> TyFamily r s t u deriving instance (Show a, Show b, Show c, Show d) => Show (TyFamily a b c d) ------------------------------------------------------------------------------- instance (a ~ Int, b ~ Int, c ~ Int, d ~ Int) => Arbitrary (TyCon a b c d) where arbitrary = oneof [ TyConClassConstraints <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary , TyConEqualityConstraints <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary , TyConTypeRefinement1 <$> arbitrary <*> arbitrary , TyConTypeRefinement2 <$> arbitrary <*> arbitrary , TyConForalls <$> (arbitrary :: Gen Int) <*> (arbitrary :: Gen Int) <*> arbitrary <*> arbitrary ] instance (a ~ Int, b ~ Int, c ~ Int, d ~ Int) => Arbitrary (TyFamily a b c d) where arbitrary = oneof [ TyFamilyClassConstraints <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary , TyFamilyEqualityConstraints <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary , TyFamilyTypeRefinement1 <$> arbitrary <*> arbitrary , TyFamilyTypeRefinement2 <$> arbitrary <*> arbitrary , TyFamilyForalls <$> (arbitrary :: Gen Int) <*> (arbitrary :: Gen Int) <*> arbitrary <*> arbitrary ] ------------------------------------------------------------------------------- $(deriveShow1 ''TyCon) #if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2 ''TyCon) #endif $(deriveTextShow ''TyCon) $(deriveTextShow1 ''TyCon) $(deriveTextShow2 ''TyCon) #if MIN_VERSION_template_haskell(2,7,0) # if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 'TyFamilyClassConstraints) # else $(deriveShow1 'TyFamilyTypeRefinement1) $(deriveShow2 'TyFamilyTypeRefinement1) # endif $(deriveTextShow 'TyFamilyClassConstraints) $(deriveTextShow1 'TyFamilyTypeRefinement1) $(deriveTextShow2 'TyFamilyTypeRefinement2) #endif text-show-3.4/tests/Derived/PolyKinds.hs0000644000000000000000000002744712756060603016527 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} #endif {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Derived.PolyKinds Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Defines data types with poly-kinded type variables. -} module Derived.PolyKinds ( TyConCompose(..) , TyConProxy(..) , TyConReallyHighKinds , TyFamilyCompose(..) , TyFamilyProxy(..) , TyFamilyReallyHighKinds(..) ) where #include "generic.h" import Data.Functor.Classes (Show1(..)) import Generics.Deriving.Base #if !defined(__LANGUAGE_DERIVE_GENERIC1__) import qualified Generics.Deriving.TH as Generics #endif import Test.QuickCheck (Arbitrary) import Text.Show.Deriving (deriveShow1) import TextShow (TextShow(..), TextShow1(..), TextShow2(..)) import TextShow.TH (deriveTextShow2, makeShowbPrec, makeLiftShowbPrec, makeLiftShowbPrec2) #if defined(NEW_FUNCTOR_CLASSES) import Data.Functor.Classes (Show2(..)) import Text.Show.Deriving (deriveShow2, makeLiftShowsPrec, makeLiftShowsPrec2) #else import Text.Show.Deriving (makeShowsPrec1) #endif ------------------------------------------------------------------------------- -- NB: Don't use k as a type variable here! It'll trigger GHC Trac #12503. newtype TyConCompose f g h j p a b = TyConCompose (f (g (j a) (p a)) (h (j a) (p b))) #if __GLASGOW_HASKELL__ >= 702 deriving Generic #endif deriving instance Arbitrary (f (g (j a) (k a)) (h (j a) (k b))) => Arbitrary (TyConCompose f g h j k a b) #if defined(__LANGUAGE_DERIVE_GENERIC1__) deriving instance ( Functor (f (g (j a) (k a))) , Functor (h (j a)) ) => Generic1 (TyConCompose f g h j k a) #endif deriving instance Show (f (g (j a) (k a)) (h (j a) (k b))) => Show (TyConCompose f g h j k a b) ------------------------------------------------------------------------------- newtype TyConProxy a b where TyConProxy :: () -> TyConProxy a b deriving ( Arbitrary , Show #if __GLASGOW_HASKELL__ >= 702 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #endif ) ------------------------------------------------------------------------------- newtype TyConReallyHighKinds f a b c d e = TyConReallyHighKinds (f a b c d e) deriving ( Arbitrary , Show #if __GLASGOW_HASKELL__ >= 702 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #endif ) ------------------------------------------------------------------------------- data family TyFamilyCompose #if __GLASGOW_HASKELL__ >= 706 (t :: k1 -> k2 -> *) (u :: k3 -> k4 -> k1) (v :: k3 -> k4 -> k2) (w :: k5 -> k3) (x :: k5 -> k4) (y :: k5) (z :: k5) #else (t :: * -> * -> *) (u :: * -> * -> *) (v :: * -> * -> *) (w :: * -> *) (x :: * -> *) (y :: *) (z :: *) #endif :: * newtype instance TyFamilyCompose f g h j k a b = TyFamilyCompose (f (g (j a) (k a)) (h (j a) (k b))) #if __GLASGOW_HASKELL__ >= 706 deriving Generic #endif deriving instance Arbitrary (f (g (j a) (k a)) (h (j a) (k b))) => Arbitrary (TyFamilyCompose f g h j k a b) #if defined(__LANGUAGE_DERIVE_GENERIC1__) deriving instance ( Functor (f (g (j a) (k a))) , Functor (h (j a)) ) => Generic1 (TyFamilyCompose f g h j k a) #endif deriving instance Show (f (g (j a) (k a)) (h (j a) (k b))) => Show (TyFamilyCompose f g h j k a b) ------------------------------------------------------------------------------- data family TyFamilyProxy #if __GLASGOW_HASKELL__ >= 706 (x :: k1) (y :: k2) #else (x :: *) (y :: *) #endif :: * newtype instance TyFamilyProxy a b where TyFamilyProxy :: () -> TyFamilyProxy a b deriving ( Arbitrary , Show #if __GLASGOW_HASKELL__ >= 706 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #endif ) ------------------------------------------------------------------------------- data family TyFamilyReallyHighKinds #if __GLASGOW_HASKELL__ >= 706 (g :: k1 -> k2 -> k3 -> k4 -> k5 -> *) (v :: k1) (w :: k2) (x :: k3) (y :: k4) (z :: k5) #else (g :: * -> * -> * -> * -> * -> *) (v :: *) (w :: *) (x :: *) (y :: *) (z :: *) #endif :: * newtype instance TyFamilyReallyHighKinds f a b c d e = TyFamilyReallyHighKinds (f a b c d e) deriving ( Arbitrary , Show #if __GLASGOW_HASKELL__ >= 706 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #endif ) ------------------------------------------------------------------------------- $(return []) -- TODO: Replace these with non-orphan instances $(deriveShow1 ''(,,,,)) #if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2 ''(,,,,)) #endif #if defined(NEW_FUNCTOR_CLASSES) instance (Show1 (f (g (j a) (k a))), Show1 (h (j a)), Show1 k) => Show1 (TyConCompose f g h j k a) where liftShowsPrec = $(makeLiftShowsPrec ''TyConCompose) instance (Show2 f, Show2 g, Show2 h, Show1 j, Show1 k) => Show2 (TyConCompose f g h j k) where liftShowsPrec2 = $(makeLiftShowsPrec2 ''TyConCompose) instance Show1 (TyConProxy (a :: *)) where liftShowsPrec = $(makeLiftShowsPrec ''TyConProxy) instance Show2 TyConProxy where liftShowsPrec2 = $(makeLiftShowsPrec2 ''TyConProxy) instance Show1 (f a b c d) => Show1 (TyConReallyHighKinds f a b c d) where liftShowsPrec = $(makeLiftShowsPrec ''TyConReallyHighKinds) instance Show2 (f a b c) => Show2 (TyConReallyHighKinds f a b c) where liftShowsPrec2 = $(makeLiftShowsPrec2 ''TyConReallyHighKinds) #else instance (Functor (f (g (j a) (k a))), Functor (h (j a)), Show1 (f (g (j a) (k a))), Show1 (h (j a)), Show1 k) => Show1 (TyConCompose f g h j k a) where showsPrec1 = $(makeShowsPrec1 ''TyConCompose) instance Show1 (TyConProxy (a :: *)) where showsPrec1 = $(makeShowsPrec1 ''TyConProxy) instance Show1 (f a b c d) => Show1 (TyConReallyHighKinds f a b c d) where showsPrec1 = $(makeShowsPrec1 ''TyConReallyHighKinds) #endif instance TextShow (f (g (j a) (k a)) (h (j a) (k b))) => TextShow (TyConCompose f g h j k a b) where showbPrec = $(makeShowbPrec ''TyConCompose) instance (TextShow1 (f (g (j a) (k a))), TextShow1 (h (j a)), TextShow1 k) => TextShow1 (TyConCompose f g h j k a) where liftShowbPrec = $(makeLiftShowbPrec ''TyConCompose) $(deriveTextShow2 ''TyConCompose) instance TextShow (TyConProxy a b) where showbPrec = $(makeShowbPrec ''TyConProxy) instance TextShow1 (TyConProxy a) where liftShowbPrec = $(makeLiftShowbPrec ''TyConProxy) $(deriveTextShow2 ''TyConProxy) instance TextShow (f a b c d e) => TextShow (TyConReallyHighKinds f a b c d e) where showbPrec = $(makeShowbPrec ''TyConReallyHighKinds) instance TextShow1 (f a b c d) => TextShow1 (TyConReallyHighKinds f a b c d) where liftShowbPrec = $(makeLiftShowbPrec ''TyConReallyHighKinds) instance TextShow2 (f a b c) => TextShow2 (TyConReallyHighKinds f a b c) where liftShowbPrec2 = $(makeLiftShowbPrec2 ''TyConReallyHighKinds) #if !defined(__LANGUAGE_DERIVE_GENERIC1__) $(Generics.deriveMeta ''TyConCompose) $(Generics.deriveRep1Options False ''TyConCompose) instance ( Functor (f (g (j a) (k a))) , Functor (h (j a)) ) => Generic1 (TyConCompose f g h j k a) where type Rep1 (TyConCompose f g h j k a) = $(Generics.makeRep1 ''TyConCompose) f g h j k a from1 = $(Generics.makeFrom1 ''TyConCompose) to1 = $(Generics.makeTo1 ''TyConCompose) $(Generics.deriveMeta ''TyConProxy) $(Generics.deriveRepresentable1 ''TyConProxy) $(Generics.deriveMeta ''TyConReallyHighKinds) $(Generics.deriveRepresentable1 ''TyConReallyHighKinds) #endif #if __GLASGOW_HASKELL__ < 702 $(Generics.deriveRepresentable0 ''TyConCompose) $(Generics.deriveRepresentable0 ''TyConProxy) $(Generics.deriveRepresentable0 ''TyConReallyHighKinds) #endif #if MIN_VERSION_template_haskell(2,7,0) # if !defined(NEW_FUNCTOR_CLASSES) instance (Functor (f (g (j a) (k a))), Functor (h (j a)), Show1 (f (g (j a) (k a))), Show1 (h (j a)), Show1 k) => Show1 (TyFamilyCompose f g h j k a) where showsPrec1 = $(makeShowsPrec1 'TyFamilyCompose) instance Show1 (TyFamilyProxy (a :: *)) where showsPrec1 = $(makeShowsPrec1 'TyFamilyProxy) instance Show1 (f a b c d) => Show1 (TyFamilyReallyHighKinds f a b c d) where showsPrec1 = $(makeShowsPrec1 'TyFamilyReallyHighKinds) # else instance (Show1 (f (g (j a) (k a))), Show1 (h (j a)), Show1 k) => Show1 (TyFamilyCompose f g h j k a) where liftShowsPrec = $(makeLiftShowsPrec 'TyFamilyCompose) instance Show1 (TyFamilyProxy (a :: *)) where liftShowsPrec = $(makeLiftShowsPrec 'TyFamilyProxy) instance Show1 (f a b c d) => Show1 (TyFamilyReallyHighKinds f a b c d) where liftShowsPrec = $(makeLiftShowsPrec 'TyFamilyReallyHighKinds) instance (Show2 f, Show2 g, Show2 h, Show1 j, Show1 k) => Show2 (TyFamilyCompose f g h j k) where liftShowsPrec2 = $(makeLiftShowsPrec2 'TyFamilyCompose) instance Show2 TyFamilyProxy where liftShowsPrec2 = $(makeLiftShowsPrec2 'TyFamilyProxy) instance Show2 (f a b c) => Show2 (TyFamilyReallyHighKinds f a b c) where liftShowsPrec2 = $(makeLiftShowsPrec2 'TyFamilyReallyHighKinds) # endif instance TextShow (f (g (j a) (k a)) (h (j a) (k b))) => TextShow (TyFamilyCompose f g h j k a b) where showbPrec = $(makeShowbPrec 'TyFamilyCompose) instance (TextShow1 (f (g (j a) (k a))), TextShow1 (h (j a)), TextShow1 k) => TextShow1 (TyFamilyCompose f g h j k a) where liftShowbPrec = $(makeLiftShowbPrec 'TyFamilyCompose) $(deriveTextShow2 'TyFamilyCompose) instance TextShow (TyFamilyProxy a b) where showbPrec = $(makeShowbPrec 'TyFamilyProxy) instance TextShow1 (TyFamilyProxy a) where liftShowbPrec = $(makeLiftShowbPrec 'TyFamilyProxy) $(deriveTextShow2 'TyFamilyProxy) instance TextShow (f a b c d e) => TextShow (TyFamilyReallyHighKinds f a b c d e) where showbPrec = $(makeShowbPrec 'TyFamilyReallyHighKinds) instance TextShow1 (f a b c d) => TextShow1 (TyFamilyReallyHighKinds f a b c d) where liftShowbPrec = $(makeLiftShowbPrec 'TyFamilyReallyHighKinds) instance TextShow2 (f a b c) => TextShow2 (TyFamilyReallyHighKinds f a b c) where liftShowbPrec2 = $(makeLiftShowbPrec2 'TyFamilyReallyHighKinds) # if !defined(__LANGUAGE_DERIVE_GENERIC1__) $(Generics.deriveMeta 'TyFamilyCompose) $(Generics.deriveRep1Options False 'TyFamilyCompose) instance ( Functor (f (g (j a) (k a))) , Functor (h (j a)) ) => Generic1 (TyFamilyCompose f g h j k a) where type Rep1 (TyFamilyCompose f g h j k a) = $(Generics.makeRep1 'TyFamilyCompose) f g h j k a from1 = $(Generics.makeFrom1 'TyFamilyCompose) to1 = $(Generics.makeTo1 'TyFamilyCompose) $(Generics.deriveMeta 'TyFamilyProxy) $(Generics.deriveRepresentable1 'TyFamilyProxy) $(Generics.deriveMeta 'TyFamilyReallyHighKinds) $(Generics.deriveRepresentable1 'TyFamilyReallyHighKinds) # endif # if __GLASGOW_HASKELL__ < 706 $(Generics.deriveRepresentable0 'TyFamilyCompose) $(Generics.deriveRepresentable0 'TyFamilyProxy) $(Generics.deriveRepresentable0 'TyFamilyReallyHighKinds) # endif #endif text-show-3.4/tests/Derived/Infix.hs0000644000000000000000000001332412756060603015655 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} #endif {-| Module: Derived.Infix Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Defines data types with infix constructors. -} module Derived.Infix ( TyConPlain(..) , TyConGADT(..) , TyFamilyPlain(..) , TyFamilyGADT(..) ) where #include "generic.h" #if !defined(__LANGUAGE_DERIVE_GENERIC1__) import qualified Generics.Deriving.TH as Generics #endif #if __GLASGOW_HASKELL__ >= 702 import GHC.Generics (Generic) # if __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic1) # endif #endif import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..), oneof) import Text.Show.Deriving (deriveShow1) #if defined(NEW_FUNCTOR_CLASSES) import Text.Show.Deriving (deriveShow2) #endif import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) ------------------------------------------------------------------------------- infixl 3 :!: infix 4 :@: infixr 5 `TyConPlain` infixr 6 `TyConFakeInfix` data TyConPlain a b = (:!:) a b | a :@: b | a `TyConPlain` b | TyConFakeInfix a b deriving ( Show #if __GLASGOW_HASKELL__ >= 702 , Generic # if __GLASGOW_HASKELL__ >= 706 , Generic1 # endif #endif ) ------------------------------------------------------------------------------- infixr 1 :., :..., :.... data TyConGADT a b where (:.) :: c -> d -> TyConGADT c d (:..) :: e -> f -> TyConGADT e f (:...) :: g -> h -> Int -> TyConGADT g h (:....) :: { tcg1 :: i, tcg2 :: j } -> TyConGADT i j deriving ( Show #if __GLASGOW_HASKELL__ >= 706 , Generic , Generic1 #endif ) ------------------------------------------------------------------------------- data family TyFamilyPlain y z :: * infixl 3 :#: infix 4 :$: infixr 5 `TyFamilyPlain` infixr 6 `TyFamilyFakeInfix` data instance TyFamilyPlain a b = (:#:) a b | a :$: b | a `TyFamilyPlain` b | TyFamilyFakeInfix a b deriving ( Show #if __GLASGOW_HASKELL__ >= 706 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #endif ) ------------------------------------------------------------------------------- data family TyFamilyGADT y z :: * infixr 1 :*, :***, :**** data instance TyFamilyGADT a b where (:*) :: c -> d -> TyFamilyGADT c d (:**) :: e -> f -> TyFamilyGADT e f (:***) :: g -> h -> Int -> TyFamilyGADT g h (:****) :: { tfg1 :: i, tfg2 :: j } -> TyFamilyGADT i j deriving ( Show #if __GLASGOW_HASKELL__ >= 706 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #endif ) ------------------------------------------------------------------------------- instance (Arbitrary a, Arbitrary b) => Arbitrary (TyConPlain a b) where arbitrary = 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 ------------------------------------------------------------------------------- $(deriveShow1 ''TyConPlain) $(deriveShow1 ''TyConGADT) #if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2 ''TyConPlain) $(deriveShow2 ''TyConGADT) #endif $(deriveTextShow ''TyConPlain) $(deriveTextShow1 ''TyConPlain) $(deriveTextShow2 ''TyConPlain) $(deriveTextShow ''TyConGADT) $(deriveTextShow1 ''TyConGADT) $(deriveTextShow2 ''TyConGADT) #if __GLASGOW_HASKELL__ < 706 $(Generics.deriveMeta ''TyConPlain) $(Generics.deriveRepresentable1 ''TyConPlain) $(Generics.deriveAll0And1 ''TyConGADT) #endif #if __GLASGOW_HASKELL__ < 702 $(Generics.deriveRepresentable0 ''TyConPlain) #endif #if MIN_VERSION_template_haskell(2,7,0) # if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 '(:#:)) $(deriveShow1 '(:*)) # else $(deriveShow1 '(:#:)) $(deriveShow2 '(:$:)) $(deriveShow1 '(:*)) $(deriveShow2 '(:***)) # endif $(deriveTextShow '(:#:)) $(deriveTextShow1 '(:$:)) $(deriveTextShow2 'TyFamilyPlain) $(deriveTextShow '(:*)) $(deriveTextShow1 '(:***)) $(deriveTextShow2 '(:****)) # if !defined(__LANGUAGE_DERIVE_GENERIC1__) $(Generics.deriveMeta '(:#:)) $(Generics.deriveRepresentable1 '(:$:)) $(Generics.deriveMeta '(:*)) $(Generics.deriveRepresentable1 '(:**)) # endif # if __GLASGOW_HASKELL__ < 706 $(Generics.deriveRepresentable0 'TyFamilyPlain) $(Generics.deriveRepresentable0 '(:***)) # endif #endif text-show-3.4/tests/Derived/DataFamilies.hs0000644000000000000000000001154212756060603017123 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} #endif #if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710 -- Starting with GHC 7.10, NullaryTypeClasses was deprecated in favor of -- MultiParamTypeClasses, which is already enabled {-# LANGUAGE NullaryTypeClasses #-} #endif {-| Module: Derived.DataFamilies Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Defines corner case-provoking data families. -} module Derived.DataFamilies ( NotAllShow(..) #if __GLASGOW_HASKELL__ >= 706 , KindDistinguished(..) #endif #if __GLASGOW_HASKELL__ >= 708 , NullaryClass(..) , NullaryData(..) #endif ) where #include "generic.h" #if !defined(__LANGUAGE_DERIVE_GENERIC1__) import qualified Generics.Deriving.TH as Generics #endif #if __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic) # if defined(__LANGUAGE_DERIVE_GENERIC1__) import GHC.Generics (Generic1) # endif #endif import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..), oneof) #if MIN_VERSION_template_haskell(2,7,0) import Text.Show.Deriving (deriveShow1) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) # if defined(NEW_FUNCTOR_CLASSES) import Text.Show.Deriving (deriveShow2) # endif #endif ------------------------------------------------------------------------------- data family NotAllShow (w :: *) (x :: *) (y :: *) (z :: *) :: * data instance NotAllShow () () () d = NASNoShow data instance NotAllShow Int b c d = NASShow1 c b | NASShow2 d deriving ( Show #if __GLASGOW_HASKELL__ >= 706 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #endif ) instance (Arbitrary b, Arbitrary c, Arbitrary d) => Arbitrary (NotAllShow Int b c d) where arbitrary = oneof [ NASShow1 <$> arbitrary <*> arbitrary , NASShow2 <$> arbitrary ] #if MIN_VERSION_template_haskell(2,7,0) # if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 'NASShow1) # else $(deriveShow1 'NASShow1) $(deriveShow2 'NASShow2) # endif $(deriveTextShow 'NASShow1) $(deriveTextShow1 'NASShow2) $(deriveTextShow2 'NASShow1) # if !defined(__LANGUAGE_DERIVE_GENERIC1__) $(Generics.deriveMeta 'NASShow1) $(Generics.deriveRepresentable1 'NASShow2) # endif # if __GLASGOW_HASKELL__ < 706 $(Generics.deriveRepresentable0 'NASShow1) # endif #endif ------------------------------------------------------------------------------- #if __GLASGOW_HASKELL__ >= 706 data family KindDistinguished (x :: k) (y :: *) (z :: *) :: * data instance KindDistinguished (a :: ()) b c = KindDistinguishedUnit b c deriving ( Show , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif ) data instance KindDistinguished (a :: Bool) b c = KindDistinguishedBool b c deriving ( Show , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif ) instance (Arbitrary b, Arbitrary c) => Arbitrary (KindDistinguished (a :: ()) b c) where arbitrary = KindDistinguishedUnit <$> arbitrary <*> arbitrary instance (Arbitrary b, Arbitrary c) => Arbitrary (KindDistinguished (a :: Bool) b c) where arbitrary = KindDistinguishedBool <$> arbitrary <*> arbitrary # if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 'KindDistinguishedUnit) $(deriveShow1 'KindDistinguishedBool) # else $(deriveShow1 'KindDistinguishedUnit) $(deriveShow2 'KindDistinguishedUnit) $(deriveShow1 'KindDistinguishedBool) $(deriveShow2 'KindDistinguishedBool) # endif $(deriveTextShow 'KindDistinguishedUnit) $(deriveTextShow1 'KindDistinguishedUnit) $(deriveTextShow2 'KindDistinguishedUnit) $(deriveTextShow 'KindDistinguishedBool) $(deriveTextShow1 'KindDistinguishedBool) $(deriveTextShow2 'KindDistinguishedBool) # if !defined(__LANGUAGE_DERIVE_GENERIC1__) $(Generics.deriveAll1 'KindDistinguishedUnit) $(Generics.deriveAll1 'KindDistinguishedBool) # endif #endif ------------------------------------------------------------------------------- #if __GLASGOW_HASKELL__ >= 708 class NullaryClass where data NullaryData :: * instance NullaryClass where newtype NullaryData = NullaryCon Int deriving (Arbitrary, Show, Generic) $(deriveTextShow 'NullaryCon) #endif text-show-3.4/tests/Derived/TypeSynonyms.hs0000644000000000000000000000661612756060603017307 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} #endif {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Derived.TypeSynonyms Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Defines data types that use type synonyms. -} module Derived.TypeSynonyms (TyCon(..), TyFamily(..)) where #include "generic.h" #if !defined(__LANGUAGE_DERIVE_GENERIC1__) import qualified Generics.Deriving.TH as Generics #endif #if __GLASGOW_HASKELL__ >= 702 import GHC.Generics (Generic) # if __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic1) # endif #endif import Prelude import Test.QuickCheck (Arbitrary) import Text.Show.Deriving (deriveShow1) #if defined(NEW_FUNCTOR_CLASSES) import Text.Show.Deriving (deriveShow2) #endif import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) ------------------------------------------------------------------------------- type FakeOut a = Int type Id a = a type Flip f a b = f b a -- Needed for the Generic1 instances instance Functor ((,,,) a b c) where fmap f (a, b, c, d) = (a, b, c, f d) ------------------------------------------------------------------------------- newtype TyCon a b = TyCon ( Id (FakeOut (Id a)) , Id (FakeOut (Id b)) , Id (Flip Either (Id a) (Id Int)) , Id (Flip Either (Id b) (Id a)) ) deriving ( Arbitrary , Show #if __GLASGOW_HASKELL__ >= 702 , Generic # if __GLASGOW_HASKELL__ >= 706 , Generic1 # endif #endif ) ------------------------------------------------------------------------------- data family TyFamily y z :: * newtype instance TyFamily a b = TyFamily ( Id (FakeOut (Id a)) , Id (FakeOut (Id b)) , Id (Flip Either (Id a) (Id Int)) , Id (Flip Either (Id b) (Id a)) ) deriving ( Arbitrary , Show #if __GLASGOW_HASKELL__ >= 706 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #endif ) ------------------------------------------------------------------------------- -- TODO: Replace these with non-orphan instances $(deriveShow1 ''(,,,)) #if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2 ''(,,,)) #endif $(deriveShow1 ''TyCon) #if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2 ''TyCon) #endif $(deriveTextShow ''TyCon) $(deriveTextShow1 ''TyCon) $(deriveTextShow2 ''TyCon) #if __GLASGOW_HASKELL__ < 706 $(Generics.deriveMeta ''TyCon) $(Generics.deriveRepresentable1 ''TyCon) #endif #if __GLASGOW_HASKELL__ < 702 $(Generics.deriveRepresentable0 ''TyCon) #endif #if MIN_VERSION_template_haskell(2,7,0) # if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 'TyFamily) # else $(deriveShow1 'TyFamily) $(deriveShow2 'TyFamily) # endif $(deriveTextShow 'TyFamily) $(deriveTextShow1 'TyFamily) $(deriveTextShow2 'TyFamily) # if !defined(__LANGUAGE_DERIVE_GENERIC1__) $(Generics.deriveMeta 'TyFamily) $(Generics.deriveRepresentable1 'TyFamily) # endif # if __GLASGOW_HASKELL__ < 706 $(Generics.deriveRepresentable0 'TyFamily) # endif #endif text-show-3.4/tests/Derived/MagicHash.hs0000644000000000000000000000661712756060603016433 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} #endif {-| Module: Derived.MagicHash Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Defines data types with fields that have unlifted types. -} module Derived.MagicHash (TyCon#(..), TyFamily#(..)) where #if __GLASGOW_HASKELL__ < 711 import qualified Generics.Deriving.TH as Generics #endif import GHC.Exts #if __GLASGOW_HASKELL__ >= 711 import GHC.Generics (Generic, Generic1) #endif import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) import Text.Show.Deriving (deriveShow1Options, legacyShowOptions) #if defined(NEW_FUNCTOR_CLASSES) import Text.Show.Deriving (deriveShow2Options) #endif import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) ------------------------------------------------------------------------------- data TyCon# a b = TyCon# { tcA :: a , tcB :: b , tcInt# :: Int# , tcFloat# :: Float# , tcDouble# :: Double# , tcChar# :: Char# , tcWord# :: Word# } deriving ( Show #if __GLASGOW_HASKELL__ >= 711 , Generic , Generic1 #endif ) ------------------------------------------------------------------------------- data family TyFamily# y z :: * data instance TyFamily# a b = TyFamily# { tfA :: a , tfB :: b , tfInt# :: Int# , tfFloat# :: Float# , tfDouble# :: Double# , tfChar# :: Char# , tfWord# :: Word# } deriving ( Show #if __GLASGOW_HASKELL__ >= 711 , Generic , Generic1 #endif ) ------------------------------------------------------------------------------- instance (Arbitrary a, Arbitrary b) => Arbitrary (TyCon# a b) where arbitrary = do a <- arbitrary b <- arbitrary I# i# <- arbitrary F# f# <- arbitrary D# d# <- arbitrary C# c# <- arbitrary W# w# <- arbitrary pure $ TyCon# a b i# f# d# c# w# instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamily# a b) where arbitrary = do a <- arbitrary b <- arbitrary I# i# <- arbitrary F# f# <- arbitrary D# d# <- arbitrary C# c# <- arbitrary W# w# <- arbitrary pure $ TyFamily# a b i# f# d# c# w# ------------------------------------------------------------------------------- $(deriveShow1Options legacyShowOptions ''TyCon#) #if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2Options legacyShowOptions ''TyCon#) #endif $(deriveTextShow ''TyCon#) $(deriveTextShow1 ''TyCon#) $(deriveTextShow2 ''TyCon#) #if __GLASGOW_HASKELL__ < 711 $(Generics.deriveAll0And1 ''TyCon#) #endif #if MIN_VERSION_template_haskell(2,7,0) # if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1Options legacyShowOptions 'TyFamily#) # else $(deriveShow1Options legacyShowOptions 'TyFamily#) $(deriveShow2Options legacyShowOptions 'TyFamily#) # endif $(deriveTextShow 'TyFamily#) $(deriveTextShow1 'TyFamily#) $(deriveTextShow2 'TyFamily#) # if __GLASGOW_HASKELL__ < 711 $(Generics.deriveAll0And1 'TyFamily#) # endif #endif text-show-3.4/tests/Derived/DatatypeContexts.hs0000644000000000000000000000641412756060603020105 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DatatypeContexts #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -- I don't know how to silence the -XDatatypeContexts warnings otherwise... {-# OPTIONS_GHC -w #-} {-| Module: Derived.DatatypeContexts Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Defines data types with DatatypeContexts (which are gross, but still possible). -} module Derived.DatatypeContexts (TyCon(..), TyFamily(..)) where import Data.Functor.Classes (Show1(..)) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) import TextShow (TextShow(..), TextShow1(..), TextShow2(..)) import TextShow.TH (makeShowbPrec, makeLiftShowbPrec, makeLiftShowbPrec2) #if defined(NEW_FUNCTOR_CLASSES) import Data.Functor.Classes (Show2(..)) import Text.Show.Deriving (makeLiftShowsPrec, makeLiftShowsPrec2) #else import Text.Show.Deriving (makeShowsPrec1) #endif ------------------------------------------------------------------------------- data Ord a => TyCon a b c = TyCon a b c deriving Show ------------------------------------------------------------------------------- data family TyFamily x y z :: * data instance Ord a => TyFamily a b c = TyFamily a b c deriving Show ------------------------------------------------------------------------------- instance (Ord a, Arbitrary a, Arbitrary b, Arbitrary c) => Arbitrary (TyCon a b c) where arbitrary = TyCon <$> arbitrary <*> arbitrary <*> arbitrary instance (Ord a, Arbitrary a, Arbitrary b, Arbitrary c) => Arbitrary (TyFamily a b c) where arbitrary = TyFamily <$> arbitrary <*> arbitrary <*> arbitrary ------------------------------------------------------------------------------- $(return []) instance (Ord a, Show a, Show b) => Show1 (TyCon a b) where #if defined(NEW_FUNCTOR_CLASSES) liftShowsPrec = $(makeLiftShowsPrec ''TyCon) #else showsPrec1 = $(makeShowsPrec1 ''TyCon) #endif #if defined(NEW_FUNCTOR_CLASSES) instance (Ord a, Show a) => Show2 (TyCon a) where liftShowsPrec2 = $(makeLiftShowsPrec2 ''TyCon) #endif instance (Ord a, TextShow a, TextShow b, TextShow c) => TextShow (TyCon a b c) where showbPrec = $(makeShowbPrec ''TyCon) instance (Ord a, TextShow a, TextShow b) => TextShow1 (TyCon a b) where liftShowbPrec = $(makeLiftShowbPrec ''TyCon) instance (Ord a, TextShow a) => TextShow2 (TyCon a) where liftShowbPrec2 = $(makeLiftShowbPrec2 ''TyCon) #if MIN_VERSION_template_haskell(2,7,0) # if !defined(NEW_FUNCTOR_CLASSES) instance (Ord a, Show a, Show b) => Show1 (TyFamily a b) where showsPrec1 = $(makeShowsPrec1 'TyFamily) # else instance (Ord a, Show a, Show b) => Show1 (TyFamily a b) where liftShowsPrec = $(makeLiftShowsPrec 'TyFamily) instance (Ord a, Show a) => Show2 (TyFamily a) where liftShowsPrec2 = $(makeLiftShowsPrec2 'TyFamily) # endif instance (Ord a, TextShow a, TextShow b, TextShow c) => TextShow (TyFamily a b c) where showbPrec = $(makeShowbPrec 'TyFamily) instance (Ord a, TextShow a, TextShow b) => TextShow1 (TyFamily a b) where liftShowbPrec = $(makeLiftShowbPrec 'TyFamily) instance (Ord a, TextShow a) => TextShow2 (TyFamily a) where liftShowbPrec2 = $(makeLiftShowbPrec2 'TyFamily) #endif text-show-3.4/tests/Derived/Records.hs0000644000000000000000000000652312756060603016204 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} #endif {-| Module: Derived.Records Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Defines data types with record syntax. -} module Derived.Records (TyCon(..), TyFamily(..)) where #include "generic.h" #if !defined(__LANGUAGE_DERIVE_GENERIC1__) import qualified Generics.Deriving.TH as Generics #endif #if __GLASGOW_HASKELL__ >= 702 import GHC.Generics (Generic) # if __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic1) # endif #endif import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..), oneof) import Text.Show.Deriving (deriveShow1) #if defined(NEW_FUNCTOR_CLASSES) import Text.Show.Deriving (deriveShow2) #endif import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) ------------------------------------------------------------------------------- infixl 4 :@: data TyCon a b = TyConPrefix { tc1 :: a, tc2 :: b } | (:@:) { tc3 :: b, tc4 :: a } deriving ( Show #if __GLASGOW_HASKELL__ >= 702 , Generic # if __GLASGOW_HASKELL__ >= 706 , Generic1 # endif #endif ) ------------------------------------------------------------------------------- data family TyFamily y z :: * infixl 4 :!: data instance TyFamily a b = TyFamilyPrefix { tf1 :: a, tf2 :: b } | (:!:) { tf3 :: b, 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 ] ------------------------------------------------------------------------------- $(deriveShow1 ''TyCon) #if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2 ''TyCon) #endif $(deriveTextShow ''TyCon) $(deriveTextShow1 ''TyCon) $(deriveTextShow2 ''TyCon) #if __GLASGOW_HASKELL__ < 706 $(Generics.deriveMeta ''TyCon) $(Generics.deriveRepresentable1 ''TyCon) #endif #if __GLASGOW_HASKELL__ < 702 $(Generics.deriveRepresentable0 ''TyCon) #endif #if MIN_VERSION_template_haskell(2,7,0) # if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 'TyFamilyPrefix) # else $(deriveShow1 'TyFamilyPrefix) $(deriveShow2 '(:!:)) # endif $(deriveTextShow 'TyFamilyPrefix) $(deriveTextShow1 '(:!:)) $(deriveTextShow2 'TyFamilyPrefix) # if !defined(__LANGUAGE_DERIVE_GENERIC1__) $(Generics.deriveMeta 'TyFamilyPrefix) $(Generics.deriveRepresentable1 '(:!:)) # endif # if __GLASGOW_HASKELL__ < 706 $(Generics.deriveRepresentable0 'TyFamilyPrefix) # endif #endif text-show-3.4/tests/Derived/RankNTypes.hs0000644000000000000000000000702712756060603016641 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-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Defines data types with rank-n voodoo. -} module Derived.RankNTypes (TyCon(..), TyFamily(..)) where import Data.Functor.Classes (Show1(..)) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) import Text.Show.Deriving (deriveShow1) import TextShow (TextShow(..), TextShow1(..), TextShow2(..)) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2, makeShowbPrec, makeLiftShowbPrec, makeLiftShowbPrec2) #if defined(NEW_FUNCTOR_CLASSES) import Data.Functor.Classes (Show2(..)) import Text.Show.Deriving (deriveShow2, makeLiftShowsPrec, makeLiftShowsPrec2) #else import Text.Show.Deriving (makeShowsPrec1) #endif ------------------------------------------------------------------------------- data TyCon a b = TyCon (forall a. Tagged2 a Int b) (forall b. Tagged2 b a a) deriving instance (Show a, Show b) => Show (TyCon a b) ------------------------------------------------------------------------------- data family TyFamily x y :: * data instance TyFamily a b = TyFamily (forall a. Tagged2 a Int b) (forall b. Tagged2 b a a) deriving instance (Show a, Show b) => Show (TyFamily a b) ------------------------------------------------------------------------------- newtype Tagged2 s t c = Tagged2 c deriving Show ------------------------------------------------------------------------------- -- 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) ------------------------------------------------------------------------------- $(return []) instance Show1 (Tagged2 s t) where #if defined(NEW_FUNCTOR_CLASSES) liftShowsPrec = $(makeLiftShowsPrec ''Tagged2) #else showsPrec1 = $(makeShowsPrec1 ''Tagged2) #endif #if defined(NEW_FUNCTOR_CLASSES) instance Show2 (Tagged2 s) where liftShowsPrec2 = $(makeLiftShowsPrec2 ''Tagged2) #endif $(deriveShow1 ''TyCon) #if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2 ''TyCon) #endif $(deriveTextShow ''TyCon) $(deriveTextShow1 ''TyCon) $(deriveTextShow2 ''TyCon) #if MIN_VERSION_template_haskell(2,7,0) # if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 'TyFamily) # else $(deriveShow1 'TyFamily) $(deriveShow2 'TyFamily) # endif $(deriveTextShow 'TyFamily) $(deriveTextShow1 'TyFamily) $(deriveTextShow2 'TyFamily) #endif ------------------------------------------------------------------------------- instance TextShow c => TextShow (Tagged2 s t c) where showbPrec = $(makeShowbPrec ''Tagged2) instance TextShow1 (Tagged2 s t) where liftShowbPrec = $(makeLiftShowbPrec ''Tagged2) instance TextShow2 (Tagged2 s) where liftShowbPrec2 = $(makeLiftShowbPrec2 ''Tagged2) text-show-3.4/tests/Spec/0000755000000000000000000000000012756060603013551 5ustar0000000000000000text-show-3.4/tests/Spec/Utils.hs0000644000000000000000000000550212756060603015207 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-| Module: Spec.Utils Copyright: (C) 2014-2016 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 #if defined(NEW_FUNCTOR_CLASSES) , prop_matchesTextShow2 #endif , prop_genericTextShow , prop_genericTextShow1 ) where import Data.Functor.Classes (Show1, showsPrec1) import Generics.Deriving.Base #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(..), showbPrec1, fromString) import TextShow.Generic #if defined(NEW_FUNCTOR_CLASSES) import Data.Functor.Classes (Show2, showsPrec2) import TextShow (TextShow2(..), showbPrec2) #endif 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 = fromString (showsPrec p x "") == showbPrec p x -- | Verifies that a type's 'Show1' instances coincide for both 'String's and 'Text', -- irrespective of precedence. prop_matchesTextShow1 :: (Show1 f, Show a, TextShow1 f, TextShow a) => Int -> f a -> Bool prop_matchesTextShow1 p x = fromString (showsPrec1 p x "") == showbPrec1 p x #if defined(NEW_FUNCTOR_CLASSES) -- | Verifies that a type's 'Show2' instances coincide for both 'String's and 'Text', -- irrespective of precedence. prop_matchesTextShow2 :: (Show2 f, Show a, Show b, TextShow2 f, TextShow a, TextShow b) => Int -> f a b -> Bool prop_matchesTextShow2 p x = fromString (showsPrec2 p x "") == showbPrec2 p x #endif -- | Verifies that a type's 'TextShow' instance coincides with the output produced -- by the equivalent 'Generic' functions. prop_genericTextShow :: (TextShow a, Generic a, GTextShowB Zero (Rep a)) => Int -> a -> Bool prop_genericTextShow p x = showbPrec p x == genericShowbPrec p x -- | Verifies that a type's 'TextShow1' instance coincides with the output produced -- by the equivalent 'Generic1' functions. prop_genericTextShow1 :: ( TextShow1 f, Generic1 f , GTextShowB One (Rep1 f), TextShow a ) => Int -> f a -> Bool prop_genericTextShow1 p x = showbPrec1 p x == genericLiftShowbPrec showbPrec showbList p x text-show-3.4/tests/Spec/FromStringTextShowSpec.hs0000644000000000000000000000574512756060603020533 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.FromStringTextShowSpec Copyright: (C) 2014-2016 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) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) import TextShow (FromStringShow(..), FromTextShow(..)) #if defined(NEW_FUNCTOR_CLASSES) import Spec.Utils (prop_matchesTextShow2) import TextShow (FromStringShow1(..), FromStringShow2(..), FromTextShow1(..), FromTextShow2(..)) #endif 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) #if defined(NEW_FUNCTOR_CLASSES) describe "FromStringShow1 Maybe Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> FromStringShow1 Maybe Int -> Bool) prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> FromStringShow1 Maybe Int -> Bool) 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) #endif text-show-3.4/tests/Spec/OptionsSpec.hs0000644000000000000000000000172712756060603016362 0ustar0000000000000000{-| Module: Spec.OptionsSpec Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for 'Options' and related datatypes. -} module Spec.OptionsSpec (main, spec) where import Instances.Options () import Spec.Utils (prop_matchesTextShow, prop_genericTextShow) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) import TextShow.TH (Options, GenTextMethods) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "Options" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> Options -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> Options -> Bool) describe "GenTextMethods" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> GenTextMethods -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> GenTextMethods -> Bool) text-show-3.4/tests/Spec/BuilderSpec.hs0000644000000000000000000000336112756060603016311 0ustar0000000000000000{-| Module: Spec.BuilderSpec Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for functions that manipulate 'Builder's. -} module Spec.BuilderSpec (main, spec) where import Instances.Data.Text () import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) import TextShow (Builder, fromString, fromText, lengthB, toString, toText, unlinesB, unwordsB) main :: IO () main = hspec spec -- | Verifies 'lengthB' and 'length' produce the same output. prop_lengthB :: String -> Bool prop_lengthB s = fromIntegral (lengthB $ fromString s) == length s -- | Verifies @fromText . toText = id@. prop_toText :: Builder -> Bool prop_toText b = fromText (toText b) == b -- | Verifies @fromString . toString = id@. prop_toString :: Builder -> Bool prop_toString b = fromString (toString b) == b -- | Verifies 'unlinesB' and 'unlines' produce the same output. prop_unlinesB :: [String] -> Bool prop_unlinesB strs = unlinesB (map fromString strs) == fromString (unlines strs) -- | Verifies 'unwordsB' and 'unwords' produce the same output. prop_unwordsB :: [String] -> Bool prop_unwordsB strs = unwordsB (map fromString strs) == fromString (unwords strs) spec :: Spec spec = parallel $ do describe "lengthB" $ prop "has the same output as length" prop_lengthB describe "toString" $ prop "fromString . toString = id" prop_toString describe "toText" $ prop "fromText . toText = id" prop_toText describe "unlinesB" $ prop "has the same output as unlines" prop_unlinesB describe "unwordsB" $ prop "has the same output as unwords" prop_unwordsB text-show-3.4/tests/Spec/FunctionsSpec.hs0000644000000000000000000000122512756060603016670 0ustar0000000000000000{-| Module: Spec.FunctionsSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/GenericSpec.hs0000644000000000000000000000132212756060603016272 0ustar0000000000000000{-| Module: Spec.GenericSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/Text/0000755000000000000000000000000012756060603014475 5ustar0000000000000000text-show-3.4/tests/Spec/Text/ReadSpec.hs0000644000000000000000000000156012756060603016521 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Text.ReadSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/Derived/0000755000000000000000000000000012756060603015133 5ustar0000000000000000text-show-3.4/tests/Spec/Derived/PolyKindsSpec.hs0000644000000000000000000000611112756060603020215 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Derived.PolyKindsSpec Copyright: (C) 2014-2016 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_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 $ do describe "TyConCompose Either Either Either Maybe Maybe Int Int" $ do prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyConCompose Either Either Either Maybe Maybe Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> TyConCompose Either Either Either Maybe Maybe Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyConCompose Either Either Either Maybe Maybe Int Int -> Bool) describe "TyConProxy Int Int" $ do prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyConProxy Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> TyConProxy Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyConProxy Int Int -> Bool) describe "TyConReallyHighKinds (,,,,) Int Int Int Int Int" $ do prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyConReallyHighKinds (,,,,) Int Int Int Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> TyConReallyHighKinds (,,,,) Int Int Int Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyConReallyHighKinds (,,,,) Int Int Int Int Int -> Bool) #if MIN_VERSION_template_haskell(2,7,0) describe "TyFamilyCompose Either Either Either Maybe Maybe Int Int" $ do prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyFamilyCompose Either Either Either Maybe Maybe Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> TyFamilyCompose Either Either Either Maybe Maybe Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyFamilyCompose Either Either Either Maybe Maybe Int Int -> Bool) describe "TyFamilyProxy Int Int" $ do prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyFamilyProxy Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> TyFamilyProxy Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyFamilyProxy Int Int -> Bool) describe "TyFamilyReallyHighKinds (,,,,) Int Int Int Int Int" $ do prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyFamilyReallyHighKinds (,,,,) Int Int Int Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> TyFamilyReallyHighKinds (,,,,) Int Int Int Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyFamilyReallyHighKinds (,,,,) Int Int Int Int Int -> Bool) #endif text-show-3.4/tests/Spec/Derived/DatatypeContextsSpec.hs0000644000000000000000000000157112756060603021611 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Derived.DatatypeContextsSpec Copyright: (C) 2014-2016 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_matchesTextShow1) 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 "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyCon Int Int Int -> Bool) #if MIN_VERSION_template_haskell(2,7,0) describe "TyFamily Int Int Int" $ prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyFamily Int Int Int -> Bool) #endif text-show-3.4/tests/Spec/Derived/RecordsSpec.hs0000644000000000000000000000234612756060603017710 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Derived.RecordsSpec Copyright: (C) 2014-2016 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_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 $ do describe "TyCon Int Int" $ do prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyCon Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> TyCon Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyCon Int Int -> Bool) #if MIN_VERSION_template_haskell(2,7,0) describe "TyFamily Int Int" $ do prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyFamily Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> TyFamily Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyFamily Int Int -> Bool) #endif text-show-3.4/tests/Spec/Derived/TypeSynonymsSpec.hs0000644000000000000000000000236212756060603021006 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Derived.TypeSynonymsSpec Copyright: (C) 2014-2016 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) 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-3.4/tests/Spec/Derived/RankNTypesSpec.hs0000644000000000000000000000151612756060603020343 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Derived.RankNTypesSpec Copyright: (C) 2014-2016 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.RankNTypes 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 $ do describe "TyCon Int Int" $ prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyCon Int Int -> Bool) #if MIN_VERSION_template_haskell(2,7,0) describe "TyFamily Int Int" $ prop "TextShow2 instance" (prop_matchesTextShow1 :: Int -> TyFamily Int Int -> Bool) #endif text-show-3.4/tests/Spec/Derived/InfixSpec.hs0000644000000000000000000000361412756060603017363 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Derived.InfixSpec Copyright: (C) 2014-2016 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_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-3.4/tests/Spec/Derived/ExistentialQuantificationSpec.hs0000644000000000000000000000164112756060603023474 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Derived.ExistentialQuantificationSpec Copyright: (C) 2014-2016 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_matchesTextShow1) 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 "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyCon Int Int Int Int -> Bool) #if MIN_VERSION_template_haskell(2,7,0) describe "TyFamily Int Int Int Int" $ prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyFamily Int Int Int Int -> Bool) #endif text-show-3.4/tests/Spec/Derived/MagicHashSpec.hs0000644000000000000000000000244712756060603020135 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-| Module: Spec.Derived.MagicHashSpec Copyright: (C) 2014-2016 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_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 $ do describe "TyCon# Int Int" $ do prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyCon# Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> TyCon# Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyCon# Int Int -> Bool) #if MIN_VERSION_template_haskell(2,7,0) describe "TyFamily# Int Int" $ do prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyFamily# Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> TyFamily# Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyFamily# Int Int -> Bool) #endif text-show-3.4/tests/Spec/Derived/DataFamiliesSpec.hs0000644000000000000000000000463512756060603020635 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} #endif {-| Module: Spec.Derived.DataFamiliesSpec Copyright: (C) 2014-2016 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_matchesTextShow1, prop_genericTextShow, prop_genericTextShow1) import Test.Hspec (describe) import Test.Hspec.QuickCheck (prop) # if __GLASGOW_HASKELL__ >= 706 import Derived.DataFamilies (KindDistinguished) # endif # if __GLASGOW_HASKELL__ >= 708 import Derived.DataFamilies (NullaryData) import Spec.Utils (prop_matchesTextShow) # 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 "TextShow1 instance" (prop_matchesTextShow1 :: Int -> NotAllShow Int Int Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> NotAllShow Int Int Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> NotAllShow Int Int Int Int -> Bool) # if __GLASGOW_HASKELL__ >= 706 describe "KindDistinguished '() Int Int" $ do prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> KindDistinguished '() Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> KindDistinguished '() Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> KindDistinguished '() Int Int -> Bool) describe "KindDistinguished 'True Int Int" $ do prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> KindDistinguished 'True Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> KindDistinguished 'True Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> KindDistinguished 'True Int Int -> Bool) # endif # 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-3.4/tests/Spec/GHC/0000755000000000000000000000000012756060603014152 5ustar0000000000000000text-show-3.4/tests/Spec/GHC/FingerprintSpec.hs0000644000000000000000000000154212756060603017612 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.GHC.FingerprintSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/GHC/TypeLitsSpec.hs0000644000000000000000000000345312756060603017103 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-2016 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-3.4/tests/Spec/GHC/GenericsSpec.hs0000644000000000000000000001256512756060603017071 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TypeOperators #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} #endif {-| Module: Spec.GHC.GenericsSpec Copyright: (C) 2014-2016 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, (:+:), (:*:), (:.:) , UChar, UDouble, UFloat, UInt, UWord , Fixity, Associativity #if MIN_VERSION_base(4,9,0) , Meta(MetaData), SourceUnpackedness , SourceStrictness, DecidedStrictness #else , Arity #endif ) import Instances.GHC.Generics () import Spec.Utils (prop_matchesTextShow, prop_genericTextShow) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec #if MIN_VERSION_base(4,9,0) type MD = 'MetaData "Example" "Module" "package" 'False m1Description :: String m1Description = "M1 () ('MetaData \"Example\" \"Module\" \"package\" 'False) Maybe Int" #else type MD = () m1Description :: String m1Description = "M1 () () Maybe Int" #endif spec :: Spec spec = parallel $ do describe "Fixity" $ do 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) #if MIN_VERSION_base(4,9,0) describe "SourceUnpackedness" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> SourceUnpackedness -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> SourceUnpackedness -> Bool) describe "SourceStrictness" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> SourceStrictness -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> SourceStrictness -> Bool) describe "DecidedStrictness" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> DecidedStrictness -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> DecidedStrictness -> Bool) #else describe "Arity" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> Arity -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> Arity -> Bool) #endif describe "U1 Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> U1 Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> U1 Int -> Bool) 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 m1Description $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> M1 () MD Maybe Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> M1 () MD Maybe Int -> Bool) describe "(Maybe :+: Maybe) Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> (Maybe :+: Maybe) Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> (Maybe :+: Maybe) Int -> Bool) 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 "UChar Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> UChar Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> UChar Int -> Bool) describe "UDouble Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> UDouble Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> UDouble Int -> Bool) describe "UFloat Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> UFloat Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> UFloat Int -> Bool) describe "UInt Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> UInt Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> UInt Int -> Bool) describe "UWord Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> UWord Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> UWord Int -> Bool) text-show-3.4/tests/Spec/GHC/StaticPtrSpec.hs0000644000000000000000000000150012756060603017232 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.GHC.StaticPtrSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/GHC/StackSpec.hs0000644000000000000000000000164612756060603016375 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.GHC.StackSpec Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for 'CallStack' and 'SrcLoc'. -} module Spec.GHC.StackSpec (main, spec) where import Instances.GHC.Stack () import Prelude () import Prelude.Compat import Test.Hspec (Spec, hspec, parallel) #if MIN_VERSION_base(4,9,0) import GHC.Stack (CallStack, SrcLoc) 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,9,0) describe "CallStack" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> CallStack -> Bool) describe "SrcLoc" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> SrcLoc -> Bool) #else pure () #endif text-show-3.4/tests/Spec/GHC/StatsSpec.hs0000644000000000000000000000143412756060603016421 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.GHC.StatsSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/GHC/EventSpec.hs0000644000000000000000000000233512756060603016405 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.GHC.EventSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/GHC/Conc/0000755000000000000000000000000012756060603015034 5ustar0000000000000000text-show-3.4/tests/Spec/GHC/Conc/WindowsSpec.hs0000644000000000000000000000157412756060603017644 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.GHC.Conc.WindowsSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/GHC/RTS/0000755000000000000000000000000012756060603014622 5ustar0000000000000000text-show-3.4/tests/Spec/GHC/RTS/FlagsSpec.hs0000644000000000000000000000542412756060603017032 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.GHC.RTS.Flags Copyright: (C) 2014-2016 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) # if __GLASGOW_HASKELL__ >= 801 describe "ParFlags" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> ParFlags -> Bool) # endif #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-3.4/tests/Spec/Control/0000755000000000000000000000000012756060603015171 5ustar0000000000000000text-show-3.4/tests/Spec/Control/ConcurrentSpec.hs0000644000000000000000000000232412756060603020463 0ustar0000000000000000{-| Module: Spec.Control.ConcurrentSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/Control/ApplicativeSpec.hs0000644000000000000000000000227512756060603020607 0ustar0000000000000000{-| Module: Spec.Control.ApplicativeSpec Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "Control.Applicative" module. -} module Spec.Control.ApplicativeSpec (main, spec) where import Control.Applicative (Const, ZipList) import Control.Monad.Trans.Instances () import Data.Orphans () import Generics.Deriving.Instances () import Instances.Control.Applicative () import Spec.Utils (prop_matchesTextShow, 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 $ do describe "Const Int Int" $ prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> Const Int Int -> Bool) describe "ZipList Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> ZipList Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> ZipList Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> ZipList Int -> Bool) text-show-3.4/tests/Spec/Control/ExceptionSpec.hs0000644000000000000000000000634512756060603020306 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Control.ExceptionSpec Copyright: (C) 2014-2016 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 #if MIN_VERSION_base(4,9,0) describe "TypeError" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> TypeError -> Bool) #endif describe "Deadlock" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Deadlock -> Bool) describe "NoMethodError" $ 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-3.4/tests/Spec/Control/Monad/0000755000000000000000000000000012756060603016227 5ustar0000000000000000text-show-3.4/tests/Spec/Control/Monad/STSpec.hs0000644000000000000000000000064012756060603017724 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-3.4/tests/Spec/Foreign/0000755000000000000000000000000012756060603015142 5ustar0000000000000000text-show-3.4/tests/Spec/Foreign/PtrSpec.hs0000644000000000000000000000263012756060603017057 0ustar0000000000000000{-| Module: Spec.Foreign.PtrSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/Foreign/C/0000755000000000000000000000000012756060603015324 5ustar0000000000000000text-show-3.4/tests/Spec/Foreign/C/TypesSpec.hs0000644000000000000000000000632112756060603017601 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Foreign.C.TypesSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/System/0000755000000000000000000000000012756060603015035 5ustar0000000000000000text-show-3.4/tests/Spec/System/IOSpec.hs0000644000000000000000000000510412756060603016513 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.System.IOSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/System/ExitSpec.hs0000644000000000000000000000116512756060603017120 0ustar0000000000000000{-| Module: Spec.System.ExitSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/System/Posix/0000755000000000000000000000000012756060603016137 5ustar0000000000000000text-show-3.4/tests/Spec/System/Posix/TypesSpec.hs0000644000000000000000000000467112756060603020422 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.System.Posix.TypesSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/Numeric/0000755000000000000000000000000012756060603015153 5ustar0000000000000000text-show-3.4/tests/Spec/Numeric/NaturalSpec.hs0000644000000000000000000000120212756060603017723 0ustar0000000000000000{-| Module: Spec.Numeric.NaturalSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/Data/0000755000000000000000000000000012756060603014422 5ustar0000000000000000text-show-3.4/tests/Spec/Data/MaybeSpec.hs0000644000000000000000000000144212756060603016627 0ustar0000000000000000{-| Module: Spec.Data.MaybeSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/Data/TupleSpec.hs0000644000000000000000000001136612756060603016671 0ustar0000000000000000{-| Module: Spec.Data.TupleSpec Copyright: (C) 2014-2016 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_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 $ do describe "()" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> () -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> () -> Bool) describe "(Int, Int)" $ do prop "TextShow1 instance" (prop_matchesTextShow1 :: 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-3.4/tests/Spec/Data/OldTypeableSpec.hs0000644000000000000000000000217112756060603017776 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-2016 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-3.4/tests/Spec/Data/FloatingSpec.hs0000644000000000000000000000450612756060603017341 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Data.FloatingSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/Data/ComplexSpec.hs0000644000000000000000000000114112756060603017175 0ustar0000000000000000{-| Module: Spec.Data.ComplexSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/Data/ProxySpec.hs0000644000000000000000000000151412756060603016713 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Data.ProxySpec Copyright: (C) 2014-2016 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) #if __GLASGOW_HASKELL__ >= 702 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 . describe "Proxy Int" $ do prop "TextShow instance" (prop_matchesTextShow :: Int -> Proxy Int -> Bool) #if __GLASGOW_HASKELL__ >= 702 prop "generic TextShow" (prop_genericTextShow :: Int -> Proxy Int -> Bool) #endif text-show-3.4/tests/Spec/Data/BoolSpec.hs0000644000000000000000000000124012756060603016461 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Data.BoolSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/Data/CharSpec.hs0000644000000000000000000000201212756060603016441 0ustar0000000000000000{-| Module: Spec.Data.CharSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/Data/TextSpec.hs0000644000000000000000000000341112756060603016514 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Data.TextSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/Data/SemigroupSpec.hs0000644000000000000000000000260412756060603017545 0ustar0000000000000000{-| Module: Spec.Data.SemigroupSpec Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ tests for data types in the "Data.Semigroup" module. -} module Spec.Data.SemigroupSpec (main, spec) where import Data.Semigroup (Min, Max, First, Last, WrappedMonoid, Option, Arg) import Instances.Data.Semigroup () import Spec.Utils (prop_matchesTextShow) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do describe "Min Int" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Min Int -> Bool) describe "Max Int" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Max Int -> Bool) describe "First Int" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> First Int -> Bool) describe "Last Int" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Last Int -> Bool) describe "WrappedMonoid ()" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> WrappedMonoid () -> Bool) describe "Option Int" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Option Int -> Bool) describe "Arg Int Char" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Arg Int Char -> Bool) text-show-3.4/tests/Spec/Data/IntegralSpec.hs0000644000000000000000000000560612756060603017345 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Data.IntegralSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/Data/ListSpec.hs0000644000000000000000000000235312756060603016507 0ustar0000000000000000{-| Module: Spec.Data.ListSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/Data/FixedSpec.hs0000644000000000000000000000336312756060603016635 0ustar0000000000000000{-| Module: Spec.Data.FixedSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/Data/TypeableSpec.hs0000644000000000000000000000214312756060603017336 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Data.TypeableSpec Copyright: (C) 2014-2016 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) #if MIN_VERSION_base(4,9,0) import GHC.Types (TrName, Module) #endif 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) #if MIN_VERSION_base(4,9,0) describe "TrName" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> TrName -> Bool) describe "Module" $ prop "TextShow instance" (prop_matchesTextShow :: Int -> Module -> Bool) #endif text-show-3.4/tests/Spec/Data/DynamicSpec.hs0000644000000000000000000000116512756060603017160 0ustar0000000000000000{-| Module: Spec.Data.DynamicSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/Data/ArraySpec.hs0000644000000000000000000000210612756060603016646 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Data.ArraySpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/Data/OrdSpec.hs0000644000000000000000000000164212756060603016320 0ustar0000000000000000{-| Module: Spec.Data.OrdSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/Data/RatioSpec.hs0000644000000000000000000000112012756060603016641 0ustar0000000000000000{-| Module: Spec.Data.RatioSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/Data/EitherSpec.hs0000644000000000000000000000151012756060603017006 0ustar0000000000000000{-| Module: Spec.Data.EitherSpec Copyright: (C) 2014-2016 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_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 "Either Int Int" $ do prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> Either Int Int -> Bool) prop "generic TextShow" (prop_genericTextShow :: Int -> Either Int Int -> Bool) prop "generic TextShow1" (prop_genericTextShow1 :: Int -> Either Int Int -> Bool) text-show-3.4/tests/Spec/Data/ByteStringSpec.hs0000644000000000000000000000221612756060603017664 0ustar0000000000000000{-| Module: Spec.Data.ByteStringSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/Data/VersionSpec.hs0000644000000000000000000000147412756060603017224 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-3.4/tests/Spec/Data/DataSpec.hs0000644000000000000000000000214312756060603016442 0ustar0000000000000000{-| Module: Spec.Data.DataSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/Data/MonoidSpec.hs0000644000000000000000000000532412756060603017022 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Data.MonoidSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/Data/Functor/0000755000000000000000000000000012756060603016042 5ustar0000000000000000text-show-3.4/tests/Spec/Data/Functor/IdentitySpec.hs0000644000000000000000000000132112756060603020777 0ustar0000000000000000{-| Module: Spec.Data.Functor.IdentitySpec Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ test for 'Identity'. -} module Spec.Data.Functor.IdentitySpec (main, spec) where import Control.Monad.Trans.Instances () import Data.Functor.Identity (Identity) import 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-3.4/tests/Spec/Data/Functor/ProductSpec.hs0000644000000000000000000000134112756060603020630 0ustar0000000000000000{-| Module: Spec.Data.Functor.ProductSpec Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ test for 'Product'. -} module Spec.Data.Functor.ProductSpec (main, spec) where import Control.Monad.Trans.Instances () import Data.Functor.Product (Product) import Instances.Data.Functor.Product () import Spec.Utils (prop_matchesTextShow1) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Product Maybe Maybe Int" $ prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> Product Maybe Maybe Int -> Bool) text-show-3.4/tests/Spec/Data/Functor/ComposeSpec.hs0000644000000000000000000000134212756060603020616 0ustar0000000000000000{-| Module: Spec.Data.Functor.ComposeSpec Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ test for 'Compose'. -} module Spec.Data.Functor.ComposeSpec (main, spec) where import Control.Monad.Trans.Instances () import Data.Functor.Compose (Compose) import Instances.Data.Functor.Compose () import Spec.Utils (prop_matchesTextShow1) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Compose Maybe Maybe Int" $ prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> Compose Maybe Maybe Int -> Bool) text-show-3.4/tests/Spec/Data/Functor/SumSpec.hs0000644000000000000000000000130212756060603017751 0ustar0000000000000000{-| Module: Spec.Data.Functor.SumSpec Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ test for 'Sum'. -} module Spec.Data.Functor.SumSpec (main, spec) where import Control.Monad.Trans.Instances () import Data.Functor.Sum (Sum) import Instances.Data.Functor.Sum () import Spec.Utils (prop_matchesTextShow1) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Sum Maybe Maybe Int" $ prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> Sum Maybe Maybe Int -> Bool) text-show-3.4/tests/Spec/Data/Type/0000755000000000000000000000000012756060603015343 5ustar0000000000000000text-show-3.4/tests/Spec/Data/Type/CoercionSpec.hs0000644000000000000000000000156312756060603020260 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module: Spec.Data.Type.CoercionSpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/Data/Type/EqualitySpec.hs0000644000000000000000000000155512756060603020315 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TypeOperators #-} {-| Module: Spec.Data.Type.EqualitySpec Copyright: (C) 2014-2016 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-3.4/tests/Spec/Data/List/0000755000000000000000000000000012756060603015335 5ustar0000000000000000text-show-3.4/tests/Spec/Data/List/NonEmptySpec.hs0000644000000000000000000000123412756060603020255 0ustar0000000000000000{-| Module: Spec.Data.List.NonEmptySpec Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC @hspec@ test for 'NonEmpty'. -} module Spec.Data.List.NonEmptySpec (main, spec) where import Data.List.NonEmpty (NonEmpty) import Instances.Data.List.NonEmpty () import Spec.Utils (prop_matchesTextShow1) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "NonEmpty Int" $ prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> NonEmpty Int -> Bool) text-show-3.4/tests/Instances/0000755000000000000000000000000012756060603014606 5ustar0000000000000000text-show-3.4/tests/Instances/Utils.hs0000644000000000000000000000061312756060603016242 0ustar0000000000000000{-| Module: Properties.Instances Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC A collection of utility functions. -} module Instances.Utils ((<@>)) where infixl 4 <@> -- | A useful way to escape a 'Functor' context. (<@>) :: Functor f => f (a -> b) -> a -> f b f <@> x = fmap ($ x) f text-show-3.4/tests/Instances/Generic.hs0000644000000000000000000000106312756060603016516 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Generic Copyright: (C) 2014-2016 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-3.4/tests/Instances/Options.hs0000644000000000000000000000117212756060603016576 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Options Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'Options' and related datatypes. -} module Instances.Options () where import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) import TextShow.TH (Options(..), GenTextMethods) deriving instance Arbitrary Options instance Arbitrary GenTextMethods where arbitrary = arbitraryBoundedEnum text-show-3.4/tests/Instances/FromStringTextShow.hs0000644000000000000000000000211212756060603020736 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.FromStringTextShow Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances 'FromStringShow' and 'FromTextShow' -} module Instances.FromStringTextShow () where import Test.QuickCheck (Arbitrary) import TextShow (FromStringShow(..), FromTextShow(..), FromStringShow1(..), FromStringShow2(..), FromTextShow1(..), FromTextShow2(..)) deriving instance Arbitrary a => Arbitrary (FromStringShow a) deriving instance Arbitrary (f a) => Arbitrary (FromStringShow1 f a) deriving instance Arbitrary (f a b) => Arbitrary (FromStringShow2 f a b) deriving instance Arbitrary a => Arbitrary (FromTextShow a) deriving instance Arbitrary (f a) => Arbitrary (FromTextShow1 f a) deriving instance Arbitrary (f a b) => Arbitrary (FromTextShow2 f a b) text-show-3.4/tests/Instances/Text/0000755000000000000000000000000012756060603015532 5ustar0000000000000000text-show-3.4/tests/Instances/Text/Read.hs0000644000000000000000000000424312756060603016744 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Text.Read Copyright: (C) 2014-2016 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-3.4/tests/Instances/GHC/0000755000000000000000000000000012756060603015207 5ustar0000000000000000text-show-3.4/tests/Instances/GHC/Stack.hs0000644000000000000000000000225412756060603016613 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.GHC.Stack Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances for 'CallStack' and 'SrcLoc'. -} module Instances.GHC.Stack () where -- Ideally, we'd also define these instances for base-4.8.1 and up, but the -- constructors for CallStack and SrcLoc aren't exposed prior to base-4.9, and -- the API doesn't provide any way to construct values of those types, so we're -- pretty much out of luck. #if MIN_VERSION_base(4,9,0) import GHC.Stack.Types (CallStack(..), SrcLoc(..)) import Instances.Utils ((<@>)) import Test.QuickCheck (Arbitrary(..), oneof) instance Arbitrary CallStack where arbitrary = oneof [ pure EmptyCallStack , PushCallStack <$> arbitrary <*> arbitrary <@> EmptyCallStack , pure $ FreezeCallStack EmptyCallStack ] instance Arbitrary SrcLoc where arbitrary = SrcLoc <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary #endif text-show-3.4/tests/Instances/GHC/TypeLits.hs0000644000000000000000000000242012756060603017316 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-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances for data types in the "GHC.TypeLits" module. -} module Instances.GHC.TypeLits () where #if MIN_VERSION_base(4,6,0) import GHC.TypeLits import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) # if MIN_VERSION_base(4,7,0) import Test.QuickCheck (getNonNegative) # endif #endif #if MIN_VERSION_base(4,7,0) instance Arbitrary SomeNat where arbitrary = do nat <- getNonNegative <$> arbitrary case someNatVal nat of Just sn -> pure sn Nothing -> fail "Negative natural number" -- Should never happen instance Arbitrary SomeSymbol where arbitrary = someSymbolVal <$> arbitrary #elif MIN_VERSION_base(4,6,0) instance SingI a => Arbitrary (Sing a) where arbitrary = pure sing instance SingI n => Arbitrary (IsZero n) where arbitrary = pure $ isZero sing instance SingI n => Arbitrary (IsEven n) where arbitrary = pure $ isEven sing #endif text-show-3.4/tests/Instances/GHC/Generics.hs0000644000000000000000000000512012756060603017300 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.GHC.Generics Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances for data types in the "GHC.Generics" module. -} module Instances.GHC.Generics () where import Data.Orphans () import Generics.Deriving.Base import GHC.Exts (Char(C#), Double(D#), Float(F#), Int(I#), Word(W#)) 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] instance Arbitrary Associativity where arbitrary = arbitraryBoundedEnum #if MIN_VERSION_base(4,9,0) instance Arbitrary SourceUnpackedness where arbitrary = arbitraryBoundedEnum instance Arbitrary SourceStrictness where arbitrary = arbitraryBoundedEnum instance Arbitrary DecidedStrictness where arbitrary = arbitraryBoundedEnum #else instance Arbitrary Arity where arbitrary = oneof [pure NoArity, Arity <$> arbitrary] #endif instance Arbitrary (UChar p) where arbitrary = do C# c <- arbitrary pure $ UChar c instance Arbitrary (UDouble p) where arbitrary = do D# d <- arbitrary pure $ UDouble d instance Arbitrary (UFloat p) where arbitrary = do F# f <- arbitrary pure $ UFloat f instance Arbitrary (UInt p) where arbitrary = do I# i <- arbitrary pure $ UInt i instance Arbitrary (UWord p) where arbitrary = do W# w <- arbitrary pure $ UWord w text-show-3.4/tests/Instances/GHC/StaticPtr.hs0000644000000000000000000000130412756060603017456 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.GHC.StaticPtr Copyright: (C) 2014-2016 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 # if __GLASGOW_HASKELL__ < 801 <*> arbitrary # endif #endif text-show-3.4/tests/Instances/GHC/Fingerprint.hs0000644000000000000000000000112412756060603020030 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.GHC.Fingerprint Copyright: (C) 2014-2016 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-3.4/tests/Instances/GHC/Event.hs0000644000000000000000000000201212756060603016617 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.GHC.Event Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances for data types in the "GHC.Event" module. -} module Instances.GHC.Event () where #if !defined(__GHCJS__) && !defined(mingw32_HOST_OS) && MIN_VERSION_base(4,4,0) import GHC.Event (Event, evtRead, evtWrite) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..), oneof) # if MIN_VERSION_base(4,8,1) import GHC.Event (Lifetime(..)) import Test.QuickCheck (arbitraryBoundedEnum) # endif instance Arbitrary Event where arbitrary = oneof $ map pure [evtRead, evtWrite] -- TODO: instance Arbitrary FdKey # if MIN_VERSION_base(4,8,1) deriving instance Bounded Lifetime deriving instance Enum Lifetime instance Arbitrary Lifetime where arbitrary = arbitraryBoundedEnum # endif #endif text-show-3.4/tests/Instances/GHC/Stats.hs0000644000000000000000000000172312756060603016644 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.GHC.Stats Copyright: (C) 2014-2016 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 # if __GLASGOW_HASKELL__ >= 801 <*> arbitrary # endif #endif text-show-3.4/tests/Instances/GHC/Conc/0000755000000000000000000000000012756060603016071 5ustar0000000000000000text-show-3.4/tests/Instances/GHC/Conc/Windows.hs0000644000000000000000000000124012756060603020054 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.GHC.Conc.Windows Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'ConsoleEvent'. -} module Instances.GHC.Conc.Windows () where #if !defined(__GHCJS__) && defined(mingw32_HOST_OS) import GHC.Conc.Windows (ConsoleEvent(..)) import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) deriving instance Bounded ConsoleEvent instance Arbitrary ConsoleEvent where arbitrary = arbitraryBoundedEnum #endif text-show-3.4/tests/Instances/GHC/RTS/0000755000000000000000000000000012756060603015657 5ustar0000000000000000text-show-3.4/tests/Instances/GHC/RTS/Flags.hs0000644000000000000000000000267012756060603017254 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.GHC.RTS.Flags Copyright: (C) 2014-2016 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(..)) #endif #if MIN_VERSION_base(4,8,0) 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 #if __GLASGOW_HASKELL__ >= 801 instance Arbitrary ParFlags where arbitrary = ParFlags <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary #endif text-show-3.4/tests/Instances/Control/0000755000000000000000000000000012756060603016226 5ustar0000000000000000text-show-3.4/tests/Instances/Control/Concurrent.hs0000644000000000000000000000166212756060603020711 0ustar0000000000000000{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Control.Concurrent Copyright: (C) 2014-2016 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-3.4/tests/Instances/Control/Exception.hs0000644000000000000000000000627412756060603020531 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Control.Exception Copyright: (C) 2014-2016 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 #if MIN_VERSION_base(4,9,0) instance Arbitrary TypeError where arbitrary = TypeError <$> arbitrary #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,9,0) 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-3.4/tests/Instances/Control/Applicative.hs0000644000000000000000000000141412756060603021023 0ustar0000000000000000{-# LANGUAGE CPP #-} #if !(MIN_VERSION_QuickCheck(2,9,0)) {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #endif {-| Module: Instances.Control.Applicative Copyright: (C) 2014-2016 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 #if !(MIN_VERSION_QuickCheck(2,9,0)) import Control.Applicative (Const(..), ZipList(..)) import Test.QuickCheck (Arbitrary) deriving instance Arbitrary a => Arbitrary (Const a b) deriving instance Arbitrary a => Arbitrary (ZipList a) #endif text-show-3.4/tests/Instances/Control/Monad/0000755000000000000000000000000012756060603017264 5ustar0000000000000000text-show-3.4/tests/Instances/Control/Monad/ST.hs0000644000000000000000000000076712756060603020160 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Control.Monad.ST Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'ST'. -} module Instances.Control.Monad.ST () where import Control.Monad.ST (ST, fixST) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) instance Arbitrary (ST s a) where arbitrary = pure $ fixST undefined text-show-3.4/tests/Instances/Foreign/0000755000000000000000000000000012756060603016177 5ustar0000000000000000text-show-3.4/tests/Instances/Foreign/Ptr.hs0000644000000000000000000000154112756060603017301 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Foreign.Ptr Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances for pointer data types. -} module Instances.Foreign.Ptr () where import Foreign.Ptr (FunPtr, IntPtr, Ptr, WordPtr, castPtrToFunPtr, nullPtr, plusPtr, ptrToIntPtr, ptrToWordPtr) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) instance Arbitrary (Ptr a) where arbitrary = plusPtr nullPtr <$> arbitrary instance Arbitrary (FunPtr a) where arbitrary = castPtrToFunPtr <$> arbitrary instance Arbitrary IntPtr where arbitrary = ptrToIntPtr <$> arbitrary instance Arbitrary WordPtr where arbitrary = ptrToWordPtr <$> arbitrary text-show-3.4/tests/Instances/Foreign/C/0000755000000000000000000000000012756060603016361 5ustar0000000000000000text-show-3.4/tests/Instances/Foreign/C/Types.hs0000644000000000000000000000746712756060603020037 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-2016 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-3.4/tests/Instances/System/0000755000000000000000000000000012756060603016072 5ustar0000000000000000text-show-3.4/tests/Instances/System/Exit.hs0000644000000000000000000000102512756060603017335 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.System.Exit Copyright: (C) 2014-2016 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-3.4/tests/Instances/System/IO.hs0000644000000000000000000000373212756060603016742 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.System.IO Copyright: (C) 2014-2016 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-3.4/tests/Instances/System/Posix/0000755000000000000000000000000012756060603017174 5ustar0000000000000000text-show-3.4/tests/Instances/System/Posix/Types.hs0000644000000000000000000000623512756060603020642 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.System.Posix.Types Copyright: (C) 2014-2016 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-3.4/tests/Instances/Numeric/0000755000000000000000000000000012756060603016210 5ustar0000000000000000text-show-3.4/tests/Instances/Numeric/Natural.hs0000644000000000000000000000206312756060603020153 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Numeric.Natural Copyright: (C) 2014-2016 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-3.4/tests/Instances/Data/0000755000000000000000000000000012756060603015457 5ustar0000000000000000text-show-3.4/tests/Instances/Data/ByteString.hs0000644000000000000000000000102612756060603020104 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.ByteString Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'ShortByteString'. -} module Instances.Data.ByteString () where import Data.ByteString.Short (ShortByteString, pack) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) instance Arbitrary ShortByteString where arbitrary = pack <$> arbitrary text-show-3.4/tests/Instances/Data/Proxy.hs0000644000000000000000000000106612756060603017137 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Proxy Copyright: (C) 2014-2016 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-3.4/tests/Instances/Data/Dynamic.hs0000644000000000000000000000100312756060603017371 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Dynamic Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'Dynamic'. -} module Instances.Data.Dynamic () where import Data.Dynamic (Dynamic, toDyn) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..), Gen) instance Arbitrary Dynamic where arbitrary = toDyn <$> (arbitrary :: Gen Int) text-show-3.4/tests/Instances/Data/Data.hs0000644000000000000000000000263712756060603016674 0ustar0000000000000000{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Data Copyright: (C) 2014-2016 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-3.4/tests/Instances/Data/Text.hs0000644000000000000000000000260512756060603016742 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Text Copyright: (C) 2014-2016 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-3.4/tests/Instances/Data/OldTypeable.hs0000644000000000000000000000203112756060603020213 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-2016 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-3.4/tests/Instances/Data/Floating.hs0000644000000000000000000000113712756060603017560 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Floating Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'FPFormat'. -} module Instances.Data.Floating () where import Data.Text.Lazy.Builder.RealFloat (FPFormat(..)) import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) deriving instance Bounded FPFormat instance Arbitrary FPFormat where arbitrary = arbitraryBoundedEnum text-show-3.4/tests/Instances/Data/Semigroup.hs0000644000000000000000000000206412756060603017767 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Semigroup Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances for datatypes in the "Data.Semigroup" module. -} module Instances.Data.Semigroup () where import Data.Semigroup (Min(..), Max(..), First(..), Last(..), WrappedMonoid(..), Option(..), Arg(..)) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) deriving instance Arbitrary a => Arbitrary (Min a) deriving instance Arbitrary a => Arbitrary (Max a) deriving instance Arbitrary a => Arbitrary (First a) deriving instance Arbitrary a => Arbitrary (Last a) deriving instance Arbitrary a => Arbitrary (WrappedMonoid a) deriving instance Arbitrary a => Arbitrary (Option a) instance (Arbitrary a, Arbitrary b) => Arbitrary (Arg a b) where arbitrary = Arg <$> arbitrary <*> arbitrary text-show-3.4/tests/Instances/Data/Tuple.hs0000644000000000000000000001252212756060603017106 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Tuple Copyright: (C) 2014-2016 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(..)) #if !(MIN_VERSION_QuickCheck(2,9,0)) 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 #endif 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-3.4/tests/Instances/Data/Monoid.hs0000644000000000000000000000206612756060603017244 0ustar0000000000000000{-# LANGUAGE CPP #-} #if !(MIN_VERSION_QuickCheck(2,9,0)) {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #endif {-| Module: Instances.Data.Monoid Copyright: (C) 2014-2016 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 #if !(MIN_VERSION_QuickCheck(2,9,0)) 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 #endif text-show-3.4/tests/Instances/Data/Typeable.hs0000644000000000000000000000373712756060603017572 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Typeable Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instances for data types in the "Data.Typeable" module. -} module Instances.Data.Typeable () where #include "MachDeps.h" #if MIN_VERSION_base(4,4,0) import Data.Typeable.Internal (TypeRep(..)) import Instances.Utils ((<@>)) #else import Data.Typeable (TyCon, TypeRep, mkTyCon, typeOf) import Test.QuickCheck (Gen) #endif #if MIN_VERSION_base(4,9,0) import GHC.Types (TyCon(..), TrName(..), Module(..)) # if WORD_SIZE_IN_BITS < 64 import GHC.Word (Word64(..)) # else import GHC.Word (Word(..)) # endif import Test.QuickCheck (oneof) #elif MIN_VERSION_base(4,4,0) import Data.Typeable.Internal (TyCon(..)) #endif import Instances.GHC.Fingerprint () import Prelude () 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,9,0) arbitrary = do # if WORD_SIZE_IN_BITS < 64 W64# w1# <- arbitrary W64# w2# <- arbitrary # else W# w1# <- arbitrary W# w2# <- arbitrary # endif TyCon w1# w2# <$> arbitrary <*> arbitrary #elif MIN_VERSION_base(4,4,0) arbitrary = TyCon <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary #else arbitrary = mkTyCon <$> arbitrary #endif #if MIN_VERSION_base(4,9,0) instance Arbitrary TrName where arbitrary = oneof [pure (TrNameS "wat"#), TrNameD <$> arbitrary] instance Arbitrary Module where arbitrary = Module <$> arbitrary <*> arbitrary #endif text-show-3.4/tests/Instances/Data/Version.hs0000644000000000000000000000115412756060603017441 0ustar0000000000000000{-# LANGUAGE CPP #-} #if !(MIN_VERSION_QuickCheck(2,9,0)) {-# OPTIONS_GHC -fno-warn-orphans #-} #endif {-| Module: Instances.Data.Version Copyright: (C) 2014-2016 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 #if !(MIN_VERSION_QuickCheck(2,9,0)) import Data.Version (Version(..)) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) instance Arbitrary Version where arbitrary = Version <$> arbitrary <*> arbitrary #endif text-show-3.4/tests/Instances/Data/Char.hs0000644000000000000000000000074612756060603016677 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Char Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'GeneralCategory'. -} module Instances.Data.Char () where import Data.Char (GeneralCategory) import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) instance Arbitrary GeneralCategory where arbitrary = arbitraryBoundedEnum text-show-3.4/tests/Instances/Data/Ord.hs0000644000000000000000000000076512756060603016547 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Ord Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'Down'. -} module Instances.Data.Ord () where import GHC.Exts (Down(..)) import Test.QuickCheck (Arbitrary) deriving instance Arbitrary a => Arbitrary (Down a) text-show-3.4/tests/Instances/Data/Functor/0000755000000000000000000000000012756060603017077 5ustar0000000000000000text-show-3.4/tests/Instances/Data/Functor/Product.hs0000644000000000000000000000133312756060603021053 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif {-| Module: Instances.Data.Functor.Product Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'Product'. -} module Instances.Data.Functor.Product () where import Data.Functor.Product (Product(..)) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) instance (Arbitrary (f a), Arbitrary (g a)) => Arbitrary (Product f g a) where arbitrary = Pair <$> arbitrary <*> arbitrary text-show-3.4/tests/Instances/Data/Functor/Identity.hs0000644000000000000000000000125512756060603021227 0ustar0000000000000000{-# LANGUAGE CPP #-} #if !(MIN_VERSION_QuickCheck(2,9,0)) {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #endif {-| Module: Instances.Data.Functor.Identity Copyright: (C) 2014-2016 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 #if !(MIN_VERSION_QuickCheck(2,9,0)) import Data.Functor.Identity (Identity(..)) import Test.QuickCheck (Arbitrary) deriving instance Arbitrary a => Arbitrary (Identity a) #endif text-show-3.4/tests/Instances/Data/Functor/Compose.hs0000644000000000000000000000131012756060603021033 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif {-| Module: Instances.Data.Functor.Compose Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'Compose'. -} module Instances.Data.Functor.Compose () where import Data.Functor.Compose (Compose(..)) import Test.QuickCheck (Arbitrary) deriving instance Arbitrary (f (g a)) => Arbitrary (Compose f g a) text-show-3.4/tests/Instances/Data/Functor/Sum.hs0000644000000000000000000000132612756060603020201 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif {-| Module: Instances.Data.Functor.Sum Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'Sum'. -} module Instances.Data.Functor.Sum () where import Data.Functor.Sum (Sum(..)) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..), oneof) instance (Arbitrary (f a), Arbitrary (g a)) => Arbitrary (Sum f g a) where arbitrary = oneof [InL <$> arbitrary, InR <$> arbitrary] text-show-3.4/tests/Instances/Data/Type/0000755000000000000000000000000012756060603016400 5ustar0000000000000000text-show-3.4/tests/Instances/Data/Type/Coercion.hs0000644000000000000000000000125612756060603020501 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Type.Coercion Copyright: (C) 2014-2016 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-3.4/tests/Instances/Data/Type/Equality.hs0000644000000000000000000000130012756060603020523 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-2016 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-3.4/tests/Instances/Data/List/0000755000000000000000000000000012756060603016372 5ustar0000000000000000text-show-3.4/tests/Instances/Data/List/NonEmpty.hs0000644000000000000000000000140612756060603020500 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.List.NonEmpty Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Arbitrary' instance for 'NonEmpty'. -} module Instances.Data.List.NonEmpty () where import Data.List.NonEmpty (NonEmpty(..)) import Text.Show.Deriving (deriveShow1) #if !(MIN_VERSION_QuickCheck(2,9,0)) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) instance Arbitrary a => Arbitrary (NonEmpty a) where arbitrary = (:|) <$> arbitrary <*> arbitrary #endif -- TODO: Replace this with a non-orphan instance $(deriveShow1 ''NonEmpty) text-show-3.4/include/0000755000000000000000000000000012756060603013140 5ustar0000000000000000text-show-3.4/include/inline.h0000644000000000000000000000030412756060603014564 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-3.4/include/utils.h0000644000000000000000000000013212756060603014445 0ustar0000000000000000#ifndef UTILS_H #define UTILS_H #define OPEN_PRAGMA {-# #define CLOSE_PRAGMA #-} #endif text-show-3.4/include/overlap.h0000644000000000000000000000077312756060603014770 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-3.4/include/generic.h0000644000000000000000000000047512756060603014733 0ustar0000000000000000#ifndef GENERIC_H #define GENERIC_H #if __GLASGOW_HASKELL__ >= 709 || \ (__GLASGOW_HASKELL__ == 708 && \ defined(__GLASGOW_HASKELL_PATCHLEVEL1__) && \ __GLASGOW_HASKELL_PATCHLEVEL1__ == 4) # define __LANGUAGE_DERIVE_GENERIC1__ // Workaround for https://ghc.haskell.org/trac/ghc/ticket/9563 #endif #endif text-show-3.4/benchmarks/0000755000000000000000000000000012756060603013632 5ustar0000000000000000text-show-3.4/benchmarks/Bench.hs0000644000000000000000000001024412756060603015206 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-| Module: Bench Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Benchmarks for @text-show@. -} module Main (main) where import Control.DeepSeq (NFData) import Criterion.Main (Benchmark, bench, bgroup, defaultMain, nf) import Data.List (foldl') import qualified Data.Text as T import GHC.Generics (Generic) import TextShow (TextShow(..)) import TextShow.Generic (genericShowbPrec, genericShowtPrec, genericShowtlPrec) import TextShow.TH (deriveTextShow) main :: IO () main = defaultMain [ sampleGroup "String Show" BTLeaf1 BTBranch1 BTEmpty1 show , sampleGroup "String Show, then Text.pack" BTLeaf1 BTBranch1 BTEmpty1 (T.pack . show) , sampleGroup "TextShow (TH)" BTLeaf2 BTBranch2 BTEmpty2 showt , sampleGroup "TextShow (generics)" BTLeaf3 BTBranch3 BTEmpty3 showt , bgroup "Enumeration type" [ bench "String Show" $ nf show Violet , bench "String Show, then Text.pack" $ nf (T.pack . show) Violet , bench "TextShow (TH)" $ nf showt Violet , bench "TextShow (generics)" $ nf showt $ Color2 Violet , bench "Manually written showt" $ nf colorShowt Violet ] ] ------------------------------------------------------------------------------- -- Tree-like ADTs ------------------------------------------------------------------------------- sampleGroup :: forall a b. NFData b => String -> (Int -> a) -> (a -> a -> a) -> a -> (a -> b) -> Benchmark sampleGroup title leaf branch empty showFun = bgroup title [ bench "Small sample" $ nf smallSample pile , bench "Medium sample" $ nf mediumSample pile , bench "Large sample" $ nf largeSample pile ] where pile :: (Int -> a, a -> a -> a, a, a -> b) pile = (leaf, branch, empty, showFun) type Sample = forall a b. ( Int -> a , a -> a -> a , a , a -> b ) -> b smallSample :: Sample smallSample (leaf, branch, _, showFun) = showFun $ sampleTree leaf branch {-# NOINLINE smallSample #-} mediumSample :: Sample mediumSample (leaf, branch, empty, showFun) = showFun . foldl' branch empty . replicate 1000 $ sampleTree leaf branch {-# NOINLINE mediumSample #-} largeSample :: Sample largeSample (leaf, branch, empty, showFun) = showFun . foldl' branch empty . replicate 100000 $ sampleTree leaf branch {-# NOINLINE largeSample #-} sampleTree :: (Int -> a) -> (a -> a -> a) -> a sampleTree leaf branch = (leaf 12345 `branch` leaf 1234) `branch` leaf 123456 `branch` (leaf 1234567 `branch` leaf 123456) -- NB: constructors must be same length! data BinTree1 a = BTEmpty1 | BTLeaf1 a | BTBranch1 (BinTree1 a) (BinTree1 a) deriving Show data BinTree2 a = BTEmpty2 | BTLeaf2 a | BTBranch2 (BinTree2 a) (BinTree2 a) data BinTree3 a = BTEmpty3 | BTLeaf3 a | BTBranch3 (BinTree3 a) (BinTree3 a) deriving Generic instance TextShow a => TextShow (BinTree3 a) where showbPrec = genericShowbPrec ------------------------------------------------------------------------------- -- Simple enumeration types ------------------------------------------------------------------------------- data Color = Red | Green | Blue | Orange | Violet deriving (Generic, Show) newtype Color2 = Color2 Color instance TextShow Color2 where showbPrec p (Color2 c) = genericShowbPrec p c showtPrec p (Color2 c) = genericShowtPrec p c showtlPrec p (Color2 c) = genericShowtlPrec p c colorShowt :: Color -> T.Text colorShowt c = case c of Red -> T.pack "Red" Green -> T.pack "Green" Blue -> T.pack "Blue" Orange -> T.pack "Orange" Violet -> T.pack "Violet" ------------------------------------------------------------------------------- $(deriveTextShow ''BinTree2) $(deriveTextShow ''Color) text-show-3.4/src/0000755000000000000000000000000012756060603012304 5ustar0000000000000000text-show-3.4/src/TextShow.hs0000644000000000000000000000406312756060603014430 0ustar0000000000000000{-| Module: TextShow Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Efficiently convert from values to 'Text' via 'Builder's. /Since: 2/ -} module TextShow ( -- * The @TextShow@ classes -- ** 'TextShow' TextShow(..) , showbParen , showtParen , showtlParen , showbSpace , showtSpace , showtlSpace -- ** 'TextShow1' , TextShow1(..) , showbPrec1 , showbUnaryWith , liftShowtPrec , liftShowtlPrec -- ** 'TextShow2' , TextShow2(..) , showbPrec2 , showbBinaryWith , liftShowtPrec2 , liftShowtlPrec2 -- * 'Builder's -- ** The 'Builder' type , Builder , toText , toLazyText , toLazyTextWith , toString -- ** Constructing 'Builder's , singleton , fromText , fromLazyText , fromString -- ** Flushing the buffer state , flush -- ** 'Builder' utility functions , lengthB , unlinesB , unwordsB -- * Printing values , printT , printTL , hPrintT , hPrintTL -- * Conversions -- ** Conversion between 'TextShow' and string 'Show' , FromStringShow(..) , FromTextShow(..) , FromStringShow1(..) , FromTextShow1(..) , FromStringShow2(..) , FromTextShow2(..) , showsPrecToShowbPrec , showsToShowb , showbPrecToShowsPrec , showbToShows -- ** Conversions between 'Builder', strict 'TS.Text', and lazy 'TL.Text' , showtPrecToShowbPrec , showtlPrecToShowbPrec , showtToShowb , showtlToShowb , showbPrecToShowtPrec , showbPrecToShowtlPrec , showbToShowt , showbToShowtl ) where import qualified Data.Text as TS () import qualified Data.Text.Lazy as TL () import Data.Text.Lazy.Builder import Prelude () import TextShow.Classes import TextShow.FromStringTextShow import TextShow.Instances () import TextShow.Utils (toString, toText, lengthB, unlinesB, unwordsB) text-show-3.4/src/TextShow/0000755000000000000000000000000012756060603014071 5ustar0000000000000000text-show-3.4/src/TextShow/Classes.hs0000644000000000000000000004445512756060603016036 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} #if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE StandaloneDeriving #-} #endif {-| Module: TextShow.Classes Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC The 'TextShow', 'TextShow1', and 'TextShow2' typeclasses. -} module TextShow.Classes where #if __GLASGOW_HASKELL__ >= 708 import Data.Data (Typeable) #endif import Data.Monoid.Compat ((<>)) import qualified Data.Text as TS (Text, singleton) import qualified Data.Text.IO as TS (putStrLn, hPutStrLn) import qualified Data.Text.Lazy as TL (Text, singleton) import qualified Data.Text.Lazy.IO as TL (putStrLn, hPutStrLn) import Data.Text.Lazy (toStrict) import Data.Text.Lazy.Builder (Builder, fromLazyText, fromString, fromText, singleton, toLazyText) import GHC.Show (appPrec, appPrec1) import System.IO (Handle) import TextShow.Utils (toString, toText) ------------------------------------------------------------------------------- -- | Conversion of values to @Text@. Because there are both strict and lazy @Text@ -- variants, the 'TextShow' class deliberately avoids using @Text@ in its functions. -- Instead, 'showbPrec', 'showb', and 'showbList' all return 'Builder', an -- efficient intermediate form that can be converted to either kind of @Text@. -- -- 'Builder' is a 'Monoid', so it is useful to use the 'mappend' (or '<>') function -- to combine 'Builder's when creating 'TextShow' instances. As an example: -- -- @ -- import Data.Monoid -- import TextShow -- -- data Example = Example Int Int -- instance TextShow Example where -- showb (Example i1 i2) = showb i1 <> showbSpace <> showb i2 -- @ -- -- If you do not want to create 'TextShow' instances manually, you can alternatively -- use the "TextShow.TH" module to automatically generate default 'TextShow' -- instances using Template Haskell, or the "TextShow.Generic" module to -- quickly define 'TextShow' instances using 'genericShowbPrec'. -- -- /Since: 2/ class TextShow a where -- | Convert a value to a 'Builder' with the given predence. -- -- /Since: 2/ showbPrec :: Int -- ^ The operator precedence of the enclosing context (a number -- from @0@ to @11@). Function application has precedence @10@. -> a -- ^ The value to be converted to a 'Builder'. -> Builder showbPrec _ = showb -- | Converts a value to a strict 'TS.Text'. If you hand-define this, it should -- satisfy: -- -- @ -- 'showb' = 'showbPrec' 0 -- @ -- -- /Since: 2/ showb :: a -- ^ The value to be converted to a 'Builder'. -> Builder showb = showbPrec 0 -- | Converts a list of values to a 'Builder'. By default, this is defined as -- @'showbList = 'showbListWith' 'showb'@, but it can be overridden to allow -- for specialized displaying of lists (e.g., lists of 'Char's). -- -- /Since: 2/ showbList :: [a] -- ^ The list of values to be converted to a 'Builder'. -> Builder showbList = showbListWith showb -- | Converts a value to a strict 'TS.Text' with the given precedence. This -- can be overridden for efficiency, but it should satisfy: -- -- @ -- 'showtPrec' p = 'toStrict' . 'showtlPrec' p -- @ -- -- /Since: 3/ showtPrec :: Int -- ^ The operator precedence of the enclosing context (a number -- from @0@ to @11@). Function application has precedence @10@. -> a -- ^ The value to be converted to a strict 'TS.Text'. -> TS.Text showtPrec p = toStrict . showtlPrec p -- | Converts a value to a strict 'TS.Text'. This can be overridden for -- efficiency, but it should satisfy: -- -- @ -- 'showt' = 'showtPrec' 0 -- 'showt' = 'toStrict' . 'showtl' -- @ -- -- The first equation is the default definition of 'showt'. -- -- /Since: 3/ showt :: a -- ^ The value to be converted to a strict 'TS.Text'. -> TS.Text showt = showtPrec 0 -- | Converts a list of values to a strict 'TS.Text'. This can be overridden for -- efficiency, but it should satisfy: -- -- @ -- 'showtList' = 'toStrict' . 'showtlList' -- @ -- -- /Since: 3/ showtList :: [a] -- ^ The list of values to be converted to a strict 'TS.Text'. -> TS.Text showtList = toStrict . showtlList -- | Converts a value to a lazy 'TL.Text' with the given precedence. This -- can be overridden for efficiency, but it should satisfy: -- -- @ -- 'showtlPrec' p = 'toLazyText' . 'showbPrec' p -- @ -- -- /Since: 3/ showtlPrec :: Int -- ^ The operator precedence of the enclosing context (a number -- from @0@ to @11@). Function application has precedence @10@. -> a -- ^ The value to be converted to a lazy 'TL.Text'. -> TL.Text showtlPrec p = toLazyText . showbPrec p -- | Converts a value to a lazy 'TL.Text'. This can be overridden for -- efficiency, but it should satisfy: -- -- @ -- 'showtl' = 'showtlPrec' 0 -- 'showtl' = 'toLazyText' . 'showb' -- @ -- -- The first equation is the default definition of 'showtl'. -- -- /Since: 3/ showtl :: a -- ^ The value to be converted to a lazy 'TL.Text'. -> TL.Text showtl = showtlPrec 0 -- | Converts a list of values to a lazy 'TL.Text'. This can be overridden for -- efficiency, but it should satisfy: -- -- @ -- 'showtlList' = 'toLazyText' . 'showbList' -- @ -- -- /Since: 3/ showtlList :: [a] -- ^ The list of values to be converted to a lazy 'TL.Text'. -> TL.Text showtlList = toLazyText . showbList #if __GLASGOW_HASKELL__ >= 708 {-# MINIMAL showbPrec | showb #-} deriving instance Typeable TextShow #endif -- | Surrounds 'Builder' output with parentheses if the 'Bool' parameter is 'True'. -- -- /Since: 2/ showbParen :: Bool -> Builder -> Builder showbParen p builder | p = singleton '(' <> builder <> singleton ')' | otherwise = builder -- | Construct a 'Builder' containing a single space character. -- -- /Since: 2/ showbSpace :: Builder showbSpace = singleton ' ' -- | Converts a list of values into a 'Builder' in which the values are surrounded -- by square brackets and each value is separated by a comma. The function argument -- controls how each element is shown. -- -- @'showbListWith' 'showb'@ is the default implementation of 'showbList' save for -- a few special cases (e.g., 'String'). -- -- /Since: 2/ showbListWith :: (a -> Builder) -> [a] -> Builder showbListWith _ [] = "[]" showbListWith showbx (x:xs) = singleton '[' <> showbx x <> go xs -- "[.. where go (y:ys) = singleton ',' <> showbx y <> go ys -- ..,.. go [] = singleton ']' -- ..]" -- | Surrounds strict 'TS.Text' output with parentheses if the 'Bool' parameter is 'True'. -- -- /Since: 3.4/ showtParen :: Bool -> TS.Text -> TS.Text showtParen p t | p = TS.singleton '(' <> t <> TS.singleton ')' | otherwise = t -- | Construct a strict 'TS.Text' containing a single space character. -- -- /Since: 3.4/ showtSpace :: TS.Text showtSpace = TS.singleton ' ' -- | Converts a list of values into a strict 'TS.Text' in which the values are surrounded -- by square brackets and each value is separated by a comma. The function argument -- controls how each element is shown. -- -- /Since: 3.4/ showtListWith :: (a -> TS.Text) -> [a] -> TS.Text showtListWith _ [] = "[]" showtListWith showtx (x:xs) = TS.singleton '[' <> showtx x <> go xs -- "[.. where go (y:ys) = TS.singleton ',' <> showtx y <> go ys -- ..,.. go [] = TS.singleton ']' -- ..]" -- | Surrounds lazy 'TL.Text' output with parentheses if the 'Bool' parameter is 'True'. -- -- /Since: 3.4/ showtlParen :: Bool -> TL.Text -> TL.Text showtlParen p t | p = TL.singleton '(' <> t <> TL.singleton ')' | otherwise = t {-# INLINE showtlParen #-} -- | Construct a lazy 'TL.Text' containing a single space character. -- -- /Since: 3.4/ showtlSpace :: TL.Text showtlSpace = TL.singleton ' ' -- | Converts a list of values into a lazy 'TL.Text' in which the values are surrounded -- by square brackets and each value is separated by a comma. The function argument -- controls how each element is shown. -- -- /Since: 3.4/ showtlListWith :: (a -> TL.Text) -> [a] -> TL.Text showtlListWith _ [] = "[]" showtlListWith showtlx (x:xs) = TL.singleton '[' <> showtlx x <> go xs -- "[.. where go (y:ys) = TL.singleton ',' <> showtlx y <> go ys -- ..,.. go [] = TL.singleton ']' -- ..]" -- | Writes a value's strict 'TS.Text' representation to the standard output, followed -- by a newline. -- -- /Since: 2/ printT :: TextShow a => a -> IO () printT = TS.putStrLn . showt {-# INLINE printT #-} -- | Writes a value's lazy 'TL.Text' representation to the standard output, followed -- by a newline. -- -- /Since: 2/ printTL :: TextShow a => a -> IO () printTL = TL.putStrLn . showtl {-# INLINE printTL #-} -- | Writes a value's strict 'TS.Text' representation to a file handle, followed -- by a newline. -- -- /Since: 2/ hPrintT :: TextShow a => Handle -> a -> IO () hPrintT h = TS.hPutStrLn h . showt {-# INLINE hPrintT #-} -- | Writes a value's lazy 'TL.Text' representation to a file handle, followed -- by a newline. -- -- /Since: 2/ hPrintTL :: TextShow a => Handle -> a -> IO () hPrintTL h = TL.hPutStrLn h . showtl {-# INLINE hPrintTL #-} -- | Convert a precedence-aware 'ShowS'-based show function to a 'Builder'-based one. -- -- /Since: 3/ showsPrecToShowbPrec :: (Int -> a -> ShowS) -> Int -> a -> Builder showsPrecToShowbPrec sp p x = fromString $ sp p x "" {-# INLINE showsPrecToShowbPrec #-} -- | Convert a precedence-aware, strict 'TS.Text'-based show function to a 'Builder'-based one. -- -- /Since: 3.4/ showtPrecToShowbPrec :: (Int -> a -> TS.Text) -> Int -> a -> Builder showtPrecToShowbPrec sp p = fromText . sp p {-# INLINE showtPrecToShowbPrec #-} -- | Convert a precedence-aware, lazy 'TL.Text'-based show function to a 'Builder'-based one. -- -- /Since: 3.4/ showtlPrecToShowbPrec :: (Int -> a -> TL.Text) -> Int -> a -> Builder showtlPrecToShowbPrec sp p = fromLazyText . sp p {-# INLINE showtlPrecToShowbPrec #-} -- | Convert a 'ShowS'-based show function to a 'Builder'-based one. -- -- /Since: 3/ showsToShowb :: (a -> ShowS) -> a -> Builder showsToShowb sf x = fromString $ sf x "" {-# INLINE showsToShowb #-} -- | Convert a strict 'TS.Text'-based show function to a 'Builder'-based one. -- -- /Since: 3.4/ showtToShowb :: (a -> TS.Text) -> a -> Builder showtToShowb sf = fromText . sf {-# INLINE showtToShowb #-} -- | Convert a lazy 'TL.Text'-based show function to a 'Builder'-based one. -- -- /Since: 3.4/ showtlToShowb :: (a -> TL.Text) -> a -> Builder showtlToShowb sf = fromLazyText . sf {-# INLINE showtlToShowb #-} -- | Convert a precedence-aware 'Builder'-based show function to a 'ShowS'-based one. -- -- /Since: 3/ showbPrecToShowsPrec :: (Int -> a -> Builder) -> Int -> a -> ShowS showbPrecToShowsPrec sp p = showString . toString . sp p {-# INLINE showbPrecToShowsPrec #-} -- | Convert a precedence-aware 'Builder'-based show function to a strict 'TS.Text'-based one. -- -- /Since: 3.4/ showbPrecToShowtPrec :: (Int -> a -> Builder) -> Int -> a -> TS.Text showbPrecToShowtPrec sp p = toText . sp p {-# INLINE showbPrecToShowtPrec #-} -- | Convert a precedence-aware 'Builder'-based show function to a lazy 'TL.Text'-based one. -- -- /Since: 3.4/ showbPrecToShowtlPrec :: (Int -> a -> Builder) -> Int -> a -> TL.Text showbPrecToShowtlPrec sp p = toLazyText . sp p {-# INLINE showbPrecToShowtlPrec #-} -- | Convert a 'Builder'-based show function to a 'ShowS'-based one. -- -- /Since: 3/ showbToShows :: (a -> Builder) -> a -> ShowS showbToShows sf = showString . toString . sf {-# INLINE showbToShows #-} -- | Convert a 'Builder'-based show function to a strict 'TS.Text'-based one. -- -- /Since: 3/ showbToShowt :: (a -> Builder) -> a -> TS.Text showbToShowt sf = toText . sf {-# INLINE showbToShowt #-} -- | Convert a 'Builder'-based show function to a lazy 'TL.Text'-based one. -- -- /Since: 3/ showbToShowtl :: (a -> Builder) -> a -> TL.Text showbToShowtl sf = toLazyText . sf {-# INLINE showbToShowtl #-} ------------------------------------------------------------------------------- -- | Lifting of the 'TextShow' class to unary type constructors. -- -- /Since: 2/ class TextShow1 f where -- | 'showbPrec' function for an application of the type constructor -- based on 'showbPrec' and 'showbList' functions for the argument type. -- -- /Since: 3/ liftShowbPrec :: (Int -> a -> Builder) -> ([a] -> Builder) -> Int -> f a -> Builder -- | 'showbList' function for an application of the type constructor -- based on 'showbPrec' and 'showbList' functions for the argument type. -- The default implementation using standard list syntax is correct -- for most types. -- -- /Since: 3/ liftShowbList :: (Int -> a -> Builder) -> ([a] -> Builder) -> [f a] -> Builder liftShowbList sp sl = showbListWith (liftShowbPrec sp sl 0) #if __GLASGOW_HASKELL__ >= 708 {-# MINIMAL liftShowbPrec #-} deriving instance Typeable TextShow1 #endif -- | Lift the standard 'showbPrec' and 'showbList' functions through the -- type constructor. -- -- /Since: 2/ showbPrec1 :: (TextShow1 f, TextShow a) => Int -> f a -> Builder showbPrec1 = liftShowbPrec showbPrec showbList {-# INLINE showbPrec1 #-} -- | @'showbUnaryWith' sp n p x@ produces the 'Builder' representation of a unary data -- constructor with name @n@ and argument @x@, in precedence context @p@, using the -- function @sp@ to show occurrences of the type argument. -- -- /Since: 2/ showbUnaryWith :: (Int -> a -> Builder) -> Builder -> Int -> a -> Builder showbUnaryWith sp nameB p x = showbParen (p > appPrec) $ nameB <> showbSpace <> sp appPrec1 x {-# INLINE showbUnaryWith #-} -- | 'showtPrec' function for an application of the type constructor -- based on 'showtPrec' and 'showtList' functions for the argument type. -- -- The current implementation is based on `liftShowbPrec` internally. -- -- /Since: 3.4/ liftShowtPrec :: TextShow1 f => (Int -> a -> TS.Text) -> ([a] -> TS.Text) -> Int -> f a -> TS.Text liftShowtPrec sp sl = showbPrecToShowtPrec $ liftShowbPrec (showtPrecToShowbPrec sp) (showtToShowb sl) -- | 'showtlPrec' function for an application of the type constructor -- based on 'showtlPrec' and 'showtlList' functions for the argument type. -- -- The current implementation is based on `liftShowbPrec` internally. -- -- /Since: 3.4/ liftShowtlPrec :: TextShow1 f => (Int -> a -> TL.Text) -> ([a] -> TL.Text) -> Int -> f a -> TL.Text liftShowtlPrec sp sl = showbPrecToShowtlPrec $ liftShowbPrec (showtlPrecToShowbPrec sp) (showtlToShowb sl) ------------------------------------------------------------------------------- -- | Lifting of the 'TextShow' class to binary type constructors. -- -- /Since: 2/ class TextShow2 f where -- | 'showbPrec' function for an application of the type constructor -- based on 'showbPrec' and 'showbList' functions for the argument types. -- -- /Since: 3/ liftShowbPrec2 :: (Int -> a -> Builder) -> ([a] -> Builder) -> (Int -> b -> Builder) -> ([b] -> Builder) -> Int -> f a b -> Builder -- | 'showbList' function for an application of the type constructor -- based on 'showbPrec' and 'showbList' functions for the argument types. -- The default implementation using standard list syntax is correct -- for most types. -- -- /Since: 3/ liftShowbList2 :: (Int -> a -> Builder) -> ([a] -> Builder) -> (Int -> b -> Builder) -> ([b] -> Builder) -> [f a b] -> Builder liftShowbList2 sp1 sl1 sp2 sl2 = showbListWith (liftShowbPrec2 sp1 sl1 sp2 sl2 0) #if __GLASGOW_HASKELL__ >= 708 {-# MINIMAL liftShowbPrec2 #-} deriving instance Typeable TextShow2 #endif -- | Lift two 'showbPrec' functions through the type constructor. -- -- /Since: 2/ showbPrec2 :: (TextShow2 f, TextShow a, TextShow b) => Int -> f a b -> Builder showbPrec2 = liftShowbPrec2 showbPrec showbList showbPrec showbList {-# INLINE showbPrec2 #-} -- | @'showbBinaryWith' sp n p x y@ produces the 'Builder' representation of a binary -- data constructor with name @n@ and arguments @x@ and @y@, in precedence context -- @p@, using the functions @sp1@ and @sp2@ to show occurrences of the type arguments. -- -- /Since: 2/ showbBinaryWith :: (Int -> a -> Builder) -> (Int -> b -> Builder) -> Builder -> Int -> a -> b -> Builder showbBinaryWith sp1 sp2 nameB p x y = showbParen (p > appPrec) $ nameB <> showbSpace <> sp1 appPrec1 x <> showbSpace <> sp2 appPrec1 y {-# INLINE showbBinaryWith #-} -- | 'showtPrec' function for an application of the type constructor -- based on 'showtPrec' and 'showtList' functions for the argument type. -- -- The current implementation is based on `liftShowbPrec2` internally. -- -- /Since: 3.4/ liftShowtPrec2 :: TextShow2 f => (Int -> a -> TS.Text) -> ([a] -> TS.Text) -> (Int -> b -> TS.Text) -> ([b] -> TS.Text) -> Int -> f a b -> TS.Text liftShowtPrec2 sp1 sl1 sp2 sl2 = showbPrecToShowtPrec $ liftShowbPrec2 (showtPrecToShowbPrec sp1) (showtToShowb sl1) (showtPrecToShowbPrec sp2) (showtToShowb sl2) -- | 'showtlPrec' function for an application of the type constructor -- based on 'showtlPrec' and 'showtlList' functions for the argument type. -- -- The current implementation is based on `liftShowbPrec2` internally. -- -- /Since: 3.4/ liftShowtlPrec2 :: TextShow2 f => (Int -> a -> TL.Text) -> ([a] -> TL.Text) -> (Int -> b -> TL.Text) -> ([b] -> TL.Text) -> Int -> f a b -> TL.Text liftShowtlPrec2 sp1 sl1 sp2 sl2 = showbPrecToShowtlPrec $ liftShowbPrec2 (showtlPrecToShowbPrec sp1) (showtlToShowb sl1) (showtlPrecToShowbPrec sp2) (showtlToShowb sl2) text-show-3.4/src/TextShow/TH.hs0000644000000000000000000000137412756060603014745 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.TH Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Functions to mechanically derive 'TextShow', 'TextShow1', or 'TextShow2' instances, or to splice @show@-related expressions into Haskell source code. You need to enable the @TemplateHaskell@ language extension in order to use this module. /Since: 2/ -} module TextShow.TH (module TextShow.TH.Internal) where import TextShow.Instances () import TextShow.TH.Internal ------------------------------------------------------------------------------- $(deriveTextShow ''Options) $(deriveTextShow ''GenTextMethods) text-show-3.4/src/TextShow/Utils.hs0000644000000000000000000000521312756060603015526 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-| Module: TextShow.Utils Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Miscellaneous utility functions. -} module TextShow.Utils ( coerce , i2d , isInfixTypeCon , isTupleString , lengthB , toString , toText , unlinesB , unwordsB ) where import Data.Int (Int64) import Data.Text (Text) import Data.Monoid.Compat ((<>)) import Data.Text.Lazy (length, toStrict, unpack) import Data.Text.Lazy.Builder (Builder, singleton, toLazyText) import GHC.Exts (Char(C#), Int(I#)) import GHC.Prim ((+#), chr#, ord#) import Prelude () import Prelude.Compat hiding (length) #if __GLASGOW_HASKELL__ >= 708 import qualified Data.Coerce as C (Coercible, coerce) #else import Unsafe.Coerce (unsafeCoerce) #endif -- | On GHC 7.8 and later, this is 'C.coerce' from "Data.Coerce". Otherwise, it's -- 'unsafeCoerce'. #if __GLASGOW_HASKELL__ >= 708 coerce :: C.Coercible a b => a -> b coerce = C.coerce #else coerce :: a -> b coerce = unsafeCoerce #endif -- | Unsafe conversion for decimal digits. i2d :: Int -> Char i2d (I# i#) = C# (chr# (ord# '0'# +# i#)) {-# INLINE i2d #-} -- | Checks if a 'String' names a valid Haskell infix 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 #-} -- | Convert a 'Builder' to a 'String' (without surrounding it with double quotes, -- as 'show' would). -- -- /Since: 2/ toString :: Builder -> String toString = unpack . toLazyText {-# INLINE toString #-} -- | Convert a 'Builder' to a strict 'Text'. -- -- /Since: 2/ toText :: Builder -> Text toText = toStrict . toLazyText {-# INLINE toText #-} -- | Merges several 'Builder's, separating them by newlines. -- -- /Since: 2/ unlinesB :: [Builder] -> Builder unlinesB (b:bs) = b <> singleton '\n' <> unlinesB bs unlinesB [] = mempty -- | Merges several 'Builder's, separating them by spaces. -- -- /Since: 2/ unwordsB :: [Builder] -> Builder unwordsB (b:bs@(_:_)) = b <> singleton ' ' <> unwordsB bs unwordsB [b] = b unwordsB [] = mempty text-show-3.4/src/TextShow/Instances.hs0000644000000000000000000000470712756060603016364 0ustar0000000000000000{-| Module: TextShow.Instances Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Imports all orphan 'TextShow', 'TextShow1', and 'TextShow2' instances covered by @text-show@ (except for the instances in `TextShow.Functions`, which are not imported by default). -} module TextShow.Instances () where import TextShow.Control.Applicative () import TextShow.Control.Concurrent () import TextShow.Control.Exception () import TextShow.Control.Monad.ST () import TextShow.Data.Array () import TextShow.Data.Bool () import TextShow.Data.ByteString () import TextShow.Data.Char () import TextShow.Data.Complex () import TextShow.Data.Data () import TextShow.Data.Dynamic () import TextShow.Data.Either () import TextShow.Data.Fixed () import TextShow.Data.Floating () import TextShow.Data.Functor.Compose () import TextShow.Data.Functor.Identity () import TextShow.Data.Functor.Product () import TextShow.Data.Functor.Sum () import TextShow.Data.Integral () import TextShow.Data.List () import TextShow.Data.List.NonEmpty () import TextShow.Data.Maybe () import TextShow.Data.Monoid () import TextShow.Data.OldTypeable () import TextShow.Data.Ord () import TextShow.Data.Proxy () import TextShow.Data.Ratio () import TextShow.Data.Semigroup () import TextShow.Data.Text () import TextShow.Data.Tuple () import TextShow.Data.Type.Coercion () import TextShow.Data.Type.Equality () import TextShow.Data.Typeable () import TextShow.Data.Version () import TextShow.Data.Void () import TextShow.Foreign.C.Types () import TextShow.Foreign.Ptr () import TextShow.GHC.Conc.Windows () import TextShow.GHC.Event () import TextShow.GHC.Fingerprint () import TextShow.GHC.Generics () import TextShow.GHC.RTS.Flags () import TextShow.GHC.Stack () import TextShow.GHC.StaticPtr () import TextShow.GHC.Stats () import TextShow.GHC.TypeLits () import TextShow.Numeric.Natural () import TextShow.System.Exit () import TextShow.System.IO () import TextShow.System.Posix.Types () import TextShow.Text.Read () text-show-3.4/src/TextShow/Generic.hs0000644000000000000000000007037312756060603016013 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} #endif #if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE DeriveLift #-} #endif {-| Module: TextShow.Generic Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Generic versions of 'TextShow' and 'TextShow1' class functions, as an alternative to "TextShow.TH", which uses Template Haskell. Because there is no 'Generic2' class, 'TextShow2' cannot be implemented generically. This implementation is loosely based off of the @Generics.Deriving.Show@ module from the @generic-deriving@ library. /Since: 2/ -} module TextShow.Generic ( -- * Generic @show@ functions -- $generics -- ** Understanding a compiler error -- $generic_err genericShowt , genericShowtl , genericShowtPrec , genericShowtlPrec , genericShowtList , genericShowtlList , genericShowb , genericShowbPrec , genericShowbList , genericPrintT , genericPrintTL , genericHPrintT , genericHPrintTL , genericLiftShowbPrec , genericShowbPrec1 -- * Internals -- ** 'Builder' , GTextShowB(..) , GTextShowConB(..) , ShowFunsB(..) -- ** Strict 'TS.Text' , GTextShowT(..) , GTextShowConT(..) , ShowFunsT(..) -- ** Lazy 'TL.Text' , GTextShowTL(..) , GTextShowConTL(..) , ShowFunsTL(..) -- ** Other internals , IsNullary(..) , ConType(..) , Zero , One ) where import Data.Data (Data, Typeable) import Data.Functor.Contravariant (Contravariant(..)) import Data.Monoid.Compat ((<>)) import qualified Data.Text as TS (Text, pack, singleton) import qualified Data.Text.IO as TS (putStrLn, hPutStrLn) import qualified Data.Text.Lazy as TL (Text, pack, singleton) import qualified Data.Text.Lazy.IO as TL (putStrLn, hPutStrLn) import qualified Data.Text.Lazy.Builder as TB (fromString, singleton) import Data.Text.Lazy.Builder (Builder) import Generics.Deriving.Base #if __GLASGOW_HASKELL__ < 702 import qualified Generics.Deriving.TH as Generics (deriveAll) #endif import GHC.Exts (Char(C#), Double(D#), Float(F#), Int(I#), Word(W#)) import GHC.Show (appPrec, appPrec1) import Language.Haskell.TH.Lift import Prelude () import Prelude.Compat import System.IO (Handle) import TextShow.Classes (TextShow(..), TextShow1(..), showbListWith, showbParen, showbSpace, showtListWith, showtParen, showtSpace, showtlListWith, showtlParen, showtlSpace, liftShowtPrec, liftShowtlPrec) import TextShow.Instances () import TextShow.TH.Internal (deriveTextShow) import TextShow.Utils (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 liftShowbPrec = 'genericLiftShowbPrec' @ -} {- $generic_err Suppose you intend to use 'genericShowbPrec' to define a 'TextShow' instance. @ data Oops = Oops -- forgot to add \"deriving Generic\" here! instance TextShow Oops where showbPrec = 'genericShowbPrec' @ If you forget to add a @deriving 'Generic'@ clause to your data type, at compile-time, you might get an error message that begins roughly as follows: @ No instance for ('GTextShowB' 'Zero' (Rep Oops)) @ This error can be confusing, but don't let it intimidate you. The correct fix is simply to add the missing \"@deriving 'Generic'@\" clause. Similarly, if the compiler complains about not having an instance for @('GTextShowB' 'One' (Rep1 Oops1))@, add a \"@deriving 'Generic1'@\" clause. -} -- | A 'Generic' implementation of 'showt'. -- -- /Since: 2/ genericShowt :: (Generic a, GTextShowT Zero (Rep a)) => a -> TS.Text genericShowt = genericShowtPrec 0 -- | A 'Generic' implementation of 'showtl'. -- -- /Since: 2/ genericShowtl :: (Generic a, GTextShowTL Zero (Rep a)) => a -> TL.Text genericShowtl = genericShowtlPrec 0 -- | A 'Generic' implementation of 'showPrect'. -- -- /Since: 2/ genericShowtPrec :: (Generic a, GTextShowT Zero (Rep a)) => Int -> a -> TS.Text genericShowtPrec p = gShowtPrec NoShowFunsT p . from -- | A 'Generic' implementation of 'showtlPrec'. -- -- /Since: 2/ genericShowtlPrec :: (Generic a, GTextShowTL Zero (Rep a)) => Int -> a -> TL.Text genericShowtlPrec p = gShowtlPrec NoShowFunsTL p . from -- | A 'Generic' implementation of 'showtList'. -- -- /Since: 2/ genericShowtList :: (Generic a, GTextShowT Zero (Rep a)) => [a] -> TS.Text genericShowtList = showtListWith genericShowt -- | A 'Generic' implementation of 'showtlList'. -- -- /Since: 2/ genericShowtlList :: (Generic a, GTextShowTL Zero (Rep a)) => [a] -> TL.Text genericShowtlList = showtlListWith genericShowtl -- | A 'Generic' implementation of 'showb'. -- -- /Since: 2/ genericShowb :: (Generic a, GTextShowB Zero (Rep a)) => a -> Builder genericShowb = genericShowbPrec 0 -- | A 'Generic' implementation of 'showbPrec'. -- -- /Since: 2/ genericShowbPrec :: (Generic a, GTextShowB Zero (Rep a)) => Int -> a -> Builder genericShowbPrec p = gShowbPrec NoShowFunsB p . from -- | A 'Generic' implementation of 'showbList'. -- -- /Since: 2/ genericShowbList :: (Generic a, GTextShowB Zero (Rep a)) => [a] -> Builder genericShowbList = showbListWith genericShowb -- | A 'Generic' implementation of 'printT'. -- -- /Since: 2/ genericPrintT :: (Generic a, GTextShowT Zero (Rep a)) => a -> IO () genericPrintT = TS.putStrLn . genericShowt -- | A 'Generic' implementation of 'printTL'. -- -- /Since: 2/ genericPrintTL :: (Generic a, GTextShowTL Zero (Rep a)) => a -> IO () genericPrintTL = TL.putStrLn . genericShowtl -- | A 'Generic' implementation of 'hPrintT'. -- -- /Since: 2/ genericHPrintT :: (Generic a, GTextShowT Zero (Rep a)) => Handle -> a -> IO () genericHPrintT h = TS.hPutStrLn h . genericShowt -- | A 'Generic' implementation of 'hPrintTL'. -- -- /Since: 2/ genericHPrintTL :: (Generic a, GTextShowTL Zero (Rep a)) => Handle -> a -> IO () genericHPrintTL h = TL.hPutStrLn h . genericShowtl -- | A 'Generic1' implementation of 'genericLiftShowbPrec'. -- -- /Since: 2/ genericLiftShowbPrec :: (Generic1 f, GTextShowB One (Rep1 f)) => (Int -> a -> Builder) -> ([a] -> Builder) -> Int -> f a -> Builder genericLiftShowbPrec sp sl p = gShowbPrec (Show1FunsB sp sl) p . from1 -- | A 'Generic'/'Generic1' implementation of 'showbPrec1'. -- -- /Since: 2/ genericShowbPrec1 :: ( Generic a, Generic1 f , GTextShowB Zero (Rep a) , GTextShowB One (Rep1 f) ) => Int -> f a -> Builder genericShowbPrec1 = genericLiftShowbPrec genericShowbPrec genericShowbList ------------------------------------------------------------------------------- -- | Whether a constructor is a record ('Rec'), a tuple ('Tup'), is prefix ('Pref'), -- or infix ('Inf'). -- -- /Since: 2/ data ConType = Rec | Tup | Pref | Inf String deriving ( Data , Eq , Ord , Read , Show , Typeable #if __GLASGOW_HASKELL__ >= 702 , Generic #endif #if __GLASGOW_HASKELL__ >= 800 , Lift #endif ) -- | A type-level indicator that 'TextShow' is being derived generically. -- -- /Since: 3.2/ data Zero -- | A type-level indicator that 'TextShow1' is being derived generically. -- -- /Since: 3.2/ data One {- I'm not particularly proud of the code below. The issue is that we need to be able to generically work over Builders, strict Text, and lazy Text. We could just work generically over Builders only and then convert to Text after the fact, but that results in a drastic slowdown for certain datatypes (see GH-21 for an example). For the most part, the shared functionality could be abstracted with a subclass of Monoid that supports fromString, fromChar, etc. But there's a very small chance that the code below is ever going to inline properly, and the runtime cost of all those dictinary lookups is likely to be as bad as converting to Text at the end, if not worse. Therefore, I perform some ugly CPP hackery to copy-paste the generic functionality three times, once for each Text/Builder variant. I suppose I could use TH instead to make this look a little nicer, but I haven't attempted that. -} #if __GLASGOW_HASKELL__ >= 708 #define DERIVE_TYPEABLE(name) deriving instance Typeable name #else #define DERIVE_TYPEABLE(name) #endif #if __GLASGOW_HASKELL__ >= 711 #define HASH_FUNS(text_type,one_hash,two_hash,hash_prec,from_char,from_string) \ one_hash, two_hash :: text_type; \ hash_prec :: Int -> Int; \ one_hash = from_char '#'; \ two_hash = from_string "##"; \ hash_prec = const 0 #else #define HASH_FUNS(text_type,one_hash,two_hash,hash_prec,from_char,from_string) \ one_hash, two_hash :: text_type; \ hash_prec :: Int -> Int; \ one_hash = mempty; \ two_hash = mempty; \ hash_prec = id #endif #define GTEXT_SHOW(text_type,show_funs,no_show_funs,show1_funs,one_hash,two_hash,hash_prec,gtext_show,gshow_prec,gtext_show_con,gshow_prec_con,show_prec,lift_show_prec,show_space,show_paren,show_list_with,from_char,from_string) \ {- | A 'show_funs' value either stores nothing (for 'TextShow') or it stores \ the two function arguments that show occurrences of the type parameter (for \ 'TextShow1'). \ \ /Since: 3.4/ \ -}; \ data show_funs arity a where { \ no_show_funs :: show_funs Zero a \ ; show1_funs :: (Int -> a -> text_type) -> ([a] -> text_type) -> show_funs One a \ } deriving Typeable; \ \ instance Contravariant (show_funs arity) where { \ contramap _ no_show_funs = no_show_funs \ ; contramap f (show1_funs sp sl) = show1_funs (\p -> sp p . f) (sl . map f) \ }; \ \ {- | Class of generic representation types that can be converted to \ a 'text_type'. The @arity@ type variable indicates which type class is \ used. @'gtext_show' 'Zero'@ indicates 'TextShow' behavior, and \ @'gtext_show' 'One'@ indicates 'TextShow1' behavior. \ \ /Since: 3.4/ \ -}; \ class gtext_show arity f where { \ {- | This is used as the default generic implementation of 'show_prec' (if the \ @arity@ is 'Zero') or 'lift_show_prec' (if the @arity@ is 'One'). \ -} \ ; gshow_prec :: show_funs arity a -> Int -> f a -> text_type \ }; \ \ DERIVE_TYPEABLE(gtext_show); \ \ instance gtext_show arity f => gtext_show arity (D1 d f) where { \ gshow_prec sfs p (M1 x) = gshow_prec sfs p x \ }; \ \ instance gtext_show Zero V1 where { \ gshow_prec _ _ !_ = error "Void show_prec" \ }; \ \ instance gtext_show One V1 where { \ gshow_prec _ _ !_ = error "Void lift_show_prec" \ }; \ \ instance (gtext_show arity f, gtext_show arity g) => gtext_show arity (f :+: g) where { \ gshow_prec sfs p (L1 x) = gshow_prec sfs p x \ ; gshow_prec sfs p (R1 x) = gshow_prec sfs p x \ }; \ \ instance (Constructor c, gtext_show_con arity f, IsNullary f) \ => gtext_show arity (C1 c f) where { \ gshow_prec sfs p c@(M1 x) = case fixity of { \ Prefix -> show_paren ( p > appPrec \ && not (isNullary x || conIsTuple c) \ ) $ \ (if conIsTuple c \ then mempty \ else let cn = conName c \ in show_paren (isInfixTypeCon cn) $ from_string cn) \ <> (if isNullary x || conIsTuple c \ then mempty \ else from_char ' ') \ <> showbBraces t (gshow_prec_con t sfs appPrec1 x) \ ; Infix _ m -> show_paren (p > m) $ gshow_prec_con t sfs (m+1) x \ } \ where { \ fixity :: Fixity \ ; fixity = conFixity c \ \ ; t :: ConType \ ; t = if conIsRecord c \ then Rec \ else case conIsTuple c of { \ True -> Tup \ ; False -> case fixity of { \ Prefix -> Pref \ ; Infix _ _ -> Inf $ conName c \ }; \ } \ \ ; showbBraces :: ConType -> text_type -> text_type \ ; showbBraces Rec b = from_char '{' <> b <> from_char '}' \ ; showbBraces Tup b = from_char '(' <> b <> from_char ')' \ ; showbBraces Pref b = b \ ; showbBraces (Inf _) b = b \ \ ; conIsTuple :: C1 c f p -> Bool \ ; conIsTuple = isTupleString . conName \ }; \ }; \ \ {- | Class of generic representation types for which the 'ConType' has been \ determined. The @arity@ type variable indicates which type class is \ used. @'gtext_show_con' 'Zero'@ indicates 'TextShow' behavior, and \ @'gtext_show_con' 'One'@ indicates 'TextShow1' behavior. \ -}; \ class gtext_show_con arity f where { \ {- | Convert value of a specific 'ConType' to a 'text_type' with the given \ precedence. \ -} \ ; gshow_prec_con :: ConType -> show_funs arity a -> Int -> f a -> text_type \ }; \ \ DERIVE_TYPEABLE(gtext_show_con); \ \ instance gtext_show_con arity U1 where { \ gshow_prec_con _ _ _ U1 = mempty \ }; \ \ instance gtext_show_con One Par1 where { \ gshow_prec_con _ (show1_funs sp _) p (Par1 x) = sp p x \ }; \ \ instance TextShow c => gtext_show_con arity (K1 i c) where { \ gshow_prec_con _ _ p (K1 x) = show_prec p x \ }; \ \ instance TextShow1 f => gtext_show_con One (Rec1 f) where { \ gshow_prec_con _ (show1_funs sp sl) p (Rec1 x) = lift_show_prec sp sl p x \ }; \ \ instance (Selector s, gtext_show_con arity f) => gtext_show_con arity (S1 s f) where { \ gshow_prec_con t sfs p sel@(M1 x) \ | selName sel == "" = gshow_prec_con t sfs p x \ | otherwise = from_string (selName sel) \ <> " = " \ <> gshow_prec_con t sfs 0 x \ }; \ \ instance (gtext_show_con arity f, gtext_show_con arity g) \ => gtext_show_con arity (f :*: g) where { \ gshow_prec_con t@Rec sfs _ (a :*: b) = \ gshow_prec_con t sfs 0 a \ <> ", " \ <> gshow_prec_con t sfs 0 b \ ; gshow_prec_con t@(Inf o) sfs p (a :*: b) = \ gshow_prec_con t sfs p a \ <> show_space \ <> infixOp \ <> show_space \ <> gshow_prec_con t sfs p b \ where { \ infixOp :: text_type \ ; infixOp = if isInfixTypeCon o \ then from_string o \ else from_char '`' <> from_string o <> from_char '`' \ } \ ; gshow_prec_con t@Tup sfs _ (a :*: b) = \ gshow_prec_con t sfs 0 a \ <> from_char ',' \ <> gshow_prec_con t sfs 0 b \ ; gshow_prec_con t@Pref sfs p (a :*: b) = \ gshow_prec_con t sfs p a \ <> show_space \ <> gshow_prec_con t sfs p b \ }; \ \ instance (TextShow1 f, gtext_show_con One g) => gtext_show_con One (f :.: g) where { \ gshow_prec_con t sfs p (Comp1 x) = \ let gspc = gshow_prec_con t sfs \ in lift_show_prec gspc (show_list_with (gspc 0)) p x \ }; \ \ instance gtext_show_con arity UChar where { \ gshow_prec_con _ _ p (UChar c) = show_prec (hash_prec p) (C# c) <> one_hash \ }; \ \ instance gtext_show_con arity UDouble where { \ gshow_prec_con _ _ p (UDouble d) = show_prec (hash_prec p) (D# d) <> two_hash \ }; \ \ instance gtext_show_con arity UFloat where { \ gshow_prec_con _ _ p (UFloat f) = show_prec (hash_prec p) (F# f) <> one_hash \ }; \ \ instance gtext_show_con arity UInt where { \ gshow_prec_con _ _ p (UInt i) = show_prec (hash_prec p) (I# i) <> one_hash \ }; \ \ instance gtext_show_con arity UWord where { \ gshow_prec_con _ _ p (UWord w) = show_prec (hash_prec p) (W# w) <> two_hash \ }; \ \ HASH_FUNS(text_type,one_hash,two_hash,hash_prec,from_char,from_string); GTEXT_SHOW(Builder,ShowFunsB,NoShowFunsB,Show1FunsB,oneHashB,twoHashB,hashPrecB,GTextShowB,gShowbPrec,GTextShowConB,gShowbPrecCon,showbPrec,liftShowbPrec,showbSpace,showbParen,showbListWith,TB.singleton,TB.fromString) GTEXT_SHOW(TS.Text,ShowFunsT,NoShowFunsT,Show1FunsT,oneHashT,twoHashT,hashPrecT,GTextShowT,gShowtPrec,GTextShowConT,gShowtPrecCon,showtPrec,liftShowtPrec,showtSpace,showtParen,showtListWith,TS.singleton,TS.pack) GTEXT_SHOW(TL.Text,ShowFunsTL,NoShowFunsTL,Show1FunsTL,oneHashTL,twoHashTL,hashPrecTL,GTextShowTL,gShowtlPrec,GTextShowConTL,gShowtlPrecCon,showtlPrec,liftShowtlPrec,showtlSpace,showtlParen,showtlListWith,TL.singleton,TL.pack) -- | Class of generic representation types that represent a constructor with -- zero or more fields. class IsNullary f where -- Returns 'True' if the constructor has no fields. isNullary :: f a -> Bool instance IsNullary U1 where isNullary _ = True instance IsNullary Par1 where isNullary _ = False instance IsNullary (K1 i c) where isNullary _ = False instance IsNullary f => IsNullary (S1 s f) where isNullary (M1 x) = isNullary x instance IsNullary (Rec1 f) where isNullary _ = False instance IsNullary (f :*: g) where isNullary _ = False instance IsNullary (f :.: g) where isNullary _ = False instance IsNullary UChar where isNullary _ = False instance IsNullary UDouble where isNullary _ = False instance IsNullary UFloat where isNullary _ = False instance IsNullary UInt where isNullary _ = False instance IsNullary UWord where isNullary _ = False ------------------------------------------------------------------------------- $(deriveTextShow ''ConType) #if __GLASGOW_HASKELL__ < 702 $(Generics.deriveAll ''ConType) #endif #if __GLASGOW_HASKELL__ < 800 $(deriveLift ''ConType) #endif text-show-3.4/src/TextShow/Options.hs0000644000000000000000000000515612756060603016067 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} #endif #if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE AutoDeriveTypeable #-} #endif #if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE DeriveLift #-} #endif {-| Module: TextShow.FromStringTextShow Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC 'Options' and related datatypes. /Since: 3.4/ -} module TextShow.Options (Options(..), GenTextMethods(..), defaultOptions) where import Data.Data (Data, Typeable) import Data.Ix (Ix) #if __GLASGOW_HASKELL__ >= 702 import GHC.Generics (Generic) #else import qualified Generics.Deriving.TH as Generics #endif import Language.Haskell.TH.Lift -- | Options that specify how to derive 'TextShow' instances using Template Haskell. -- -- /Since: 3.4/ newtype Options = Options { genTextMethods :: GenTextMethods -- ^ When Template Haskell should generate definitions for methods which -- return @Text@? } deriving ( Data , Eq , Ord , Read , Show , Typeable #if __GLASGOW_HASKELL__ >= 702 , Generic #endif #if __GLASGOW_HASKELL__ >= 800 , Lift #endif ) -- | When should Template Haskell generate implementations for the methods of -- 'TextShow' which return @Text@? -- -- /Since: 3.4/ data GenTextMethods = AlwaysTextMethods -- ^ Always generate them. | SometimesTextMethods -- ^ Only generate when @text-show@ feels it's appropriate. | NeverTextMethods -- ^ Never generate them under any circumstances. deriving ( Bounded , Data , Enum , Eq , Ix , Ord , Read , Show , Typeable #if __GLASGOW_HASKELL__ >= 702 , Generic #endif #if __GLASGOW_HASKELL__ >= 800 , Lift #endif ) -- | Sensible default 'Options'. -- -- /Since: 3.4/ defaultOptions :: Options defaultOptions = Options { genTextMethods = SometimesTextMethods } ------------------------------------------------------------------------------- #if __GLASGOW_HASKELL__ < 702 $(Generics.deriveAll ''Options) $(Generics.deriveAll ''GenTextMethods) #endif #if __GLASGOW_HASKELL__ < 800 $(deriveLift ''Options) $(deriveLift ''GenTextMethods) #endif text-show-3.4/src/TextShow/Functions.hs0000644000000000000000000000204712756060603016400 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Functions Copyright: (C) 2014-2016 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(..), 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 = liftShowbPrec undefined undefined INLINE_INST_FUN(showbPrec) instance TextShow1 ((->) a) where liftShowbPrec = liftShowbPrec2 undefined undefined INLINE_INST_FUN(liftShowbPrec) instance TextShow2 (->) where liftShowbPrec2 _ _ _ _ _ _ = "" INLINE_INST_FUN(liftShowbPrec2) text-show-3.4/src/TextShow/FromStringTextShow.hs0000644000000000000000000005322312756060603020232 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} #endif #if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE AutoDeriveTypeable #-} #endif #if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE DeriveLift #-} #endif {-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-| Module: TextShow.FromStringTextShow Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC The 'FromStringShow' and 'FromTextShow' data types. -} module TextShow.FromStringTextShow ( FromStringShow(..) , FromTextShow(..) , FromStringShow1(..) , FromTextShow1(..) , FromStringShow2(..) , FromTextShow2(..) ) where #include "generic.h" import Data.Bifunctor.TH (deriveBifunctor, deriveBifoldable, deriveBitraversable) import Data.Data (Data, Typeable) import Data.Functor.Classes (Show1(..)) #if !defined(__LANGUAGE_DERIVE_GENERIC1__) import qualified Generics.Deriving.TH as Generics #endif #if __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic, Generic1) #endif import Language.Haskell.TH.Lift import Prelude () import Prelude.Compat import Text.ParserCombinators.ReadPrec (ReadPrec) import Text.Read (Read(..)) import TextShow.Classes (TextShow(..), TextShow1(..), TextShow2(..), showbPrec1, showbPrec2, showbPrecToShowsPrec, showsPrecToShowbPrec, showbToShows, showsToShowb) import TextShow.Utils (coerce) #if defined(NEW_FUNCTOR_CLASSES) import Data.Functor.Classes (Show2(..), showsPrec1, showsPrec2) #else import Text.Show (showListWith) #endif ------------------------------------------------------------------------------- -- | The 'TextShow' instance for 'FromStringShow' is based on its @String@ -- 'Show' instance. That is, -- -- @ -- showbPrec p ('FromStringShow' x) = 'showsToShowb' 'showsPrec' p x -- @ -- -- /Since: 2/ newtype FromStringShow a = FromStringShow { fromStringShow :: a } deriving ( Data , Eq , Foldable , Functor #if __GLASGOW_HASKELL__ >= 706 , Generic , Generic1 #endif #if __GLASGOW_HASKELL__ >= 800 , Lift #endif , Ord , Traversable , Typeable ) instance Read a => Read (FromStringShow a) where readPrec = coerce (readPrec :: ReadPrec a) readsPrec = coerce (readsPrec :: Int -> ReadS a) readList = coerce (readList :: ReadS [a]) readListPrec = coerce (readListPrec :: ReadPrec [a]) instance Show a => TextShow (FromStringShow a) where showbPrec p = showsPrecToShowbPrec showsPrec p . fromStringShow showb = showsToShowb shows . fromStringShow showbList l = showsToShowb showList (coerce l :: [a]) instance Show a => Show (FromStringShow a) where showsPrec = coerce (showsPrec :: Int -> a -> ShowS) show = coerce (show :: a -> String) showList = coerce (showList :: [a] -> ShowS) instance Show1 FromStringShow where #if defined(NEW_FUNCTOR_CLASSES) liftShowList _ sl = sl . coerceList where coerceList :: [FromStringShow a] -> [a] coerceList = coerce liftShowsPrec sp _ p = sp p . fromStringShow #else showsPrec1 p = showsPrec p . fromStringShow #endif instance TextShow1 FromStringShow where liftShowbPrec sp' _ p = showsPrecToShowbPrec (showbPrecToShowsPrec sp') p . fromStringShow liftShowbList _ sl' = showsToShowb (showbToShows sl') . coerceList where coerceList :: [FromStringShow a] -> [a] coerceList = coerce ------------------------------------------------------------------------------- -- | The @String@ 'Show' instance for 'FromTextShow' is based on its -- 'TextShow' instance. That is, -- -- @ -- showsPrec p ('FromTextShow' x) = 'showbToShows' 'showbPrec' p x -- @ -- -- /Since: 2/ newtype FromTextShow a = FromTextShow { fromTextShow :: a } deriving ( Data , Eq , Foldable , Functor #if __GLASGOW_HASKELL__ >= 706 , Generic , Generic1 #endif #if __GLASGOW_HASKELL__ >= 800 , Lift #endif , Ord , TextShow , Traversable , Typeable ) instance Read a => Read (FromTextShow a) where readPrec = coerce (readPrec :: ReadPrec a) readsPrec = coerce (readsPrec :: Int -> ReadS a) readList = coerce (readList :: ReadS [a]) readListPrec = coerce (readListPrec :: ReadPrec [a]) instance TextShow a => Show (FromTextShow a) where showsPrec p = showbPrecToShowsPrec showbPrec p . fromTextShow show (FromTextShow x) = showbToShows showb x "" showList l = showbToShows showbList (coerce l :: [a]) instance Show1 FromTextShow where #if defined(NEW_FUNCTOR_CLASSES) liftShowList _ sl = showbToShows (showsToShowb sl) . coerceList where coerceList :: [FromTextShow a] -> [a] coerceList = coerce liftShowsPrec sp _ p = showbPrecToShowsPrec (showsPrecToShowbPrec sp) p . fromTextShow #else showsPrec1 p = showbPrecToShowsPrec (showsPrecToShowbPrec showsPrec) p . fromTextShow #endif instance TextShow1 FromTextShow where liftShowbPrec sp' _ p = sp' p . fromTextShow liftShowbList _ sl' = sl' . coerceList where coerceList :: [FromTextShow a] -> [a] coerceList = coerce ------------------------------------------------------------------------------- -- | The 'TextShow1' instance for 'FromStringShow1' is based on its @String@ -- 'Show1' instance. That is, -- -- @ -- 'liftShowbPrec' sp sl p ('FromStringShow1' x) = -- 'showsPrecToShowbPrec' ('liftShowsPrec' ('showbPrecToShowsPrec' sp) -- ('showbToShows' sl)) -- p x -- @ -- -- /Since: 3/ newtype FromStringShow1 f a = FromStringShow1 { fromStringShow1 :: f a } deriving ( Eq , Ord #if __GLASGOW_HASKELL__ >= 706 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #endif #if __GLASGOW_HASKELL__ >= 800 , Data , Foldable , Functor , Lift , Show1 -- TODO: Manually implement this when you -- can derive Show1 (someday) , Traversable #endif ) #if __GLASGOW_HASKELL__ < 800 -- TODO: Manually implement this when you can derive Show1 (someday) deriving instance Show1 f => Show1 (FromStringShow1 f) deriving instance Functor f => Functor (FromStringShow1 f) deriving instance Foldable f => Foldable (FromStringShow1 f) deriving instance Traversable f => Traversable (FromStringShow1 f) # if __GLASGOW_HASKELL__ >= 708 deriving instance Typeable FromStringShow1 deriving instance ( Data (f a), Typeable f, Typeable a ) => Data (FromStringShow1 f (a :: *)) # endif #endif instance Read (f a) => Read (FromStringShow1 f a) where readPrec = coerce (readPrec :: ReadPrec (f a)) readsPrec = coerce (readsPrec :: Int -> ReadS (f a)) readList = coerce (readList :: ReadS [f a]) readListPrec = coerce (readListPrec :: ReadPrec [f a]) #if defined(NEW_FUNCTOR_CLASSES) -- | Not available if using @transformers-0.4@ instance (Show1 f, Show a) => TextShow (FromStringShow1 f a) where showbPrec = liftShowbPrec (showsPrecToShowbPrec showsPrec) (showsToShowb showList) showbList = liftShowbList (showsPrecToShowbPrec showsPrec) (showsToShowb showList) -- | Not available if using @transformers-0.4@ instance Show1 f => TextShow1 (FromStringShow1 f) where liftShowbPrec sp sl p = showsPrecToShowbPrec (liftShowsPrec (showbPrecToShowsPrec sp) (showbToShows sl)) p . fromStringShow1 liftShowbList sp sl = showsToShowb (liftShowList (showbPrecToShowsPrec sp) (showbToShows sl)) . coerceList where coerceList :: [FromStringShow1 f a] -> [f a] coerceList = coerce #endif instance (Show1 f, Show a) => Show (FromStringShow1 f a) where showsPrec = showsPrec1 showList = liftShowList showsPrec showList ------------------------------------------------------------------------------- -- | The @String@ 'Show1' instance for 'FromTextShow1' is based on its -- 'TextShow1' instance. That is, -- -- @ -- 'liftShowsPrec' sp sl p ('FromTextShow1' x) = -- 'showbPrecToShowsPrec' ('liftShowbPrec' ('showsPrecToShowbPrec' sp) -- ('showsToShowb' sl)) -- p x -- @ -- -- /Since: 3/ newtype FromTextShow1 f a = FromTextShow1 { fromTextShow1 :: f a } deriving ( Eq , Ord #if __GLASGOW_HASKELL__ >= 706 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #endif #if __GLASGOW_HASKELL__ >= 800 , Data , Foldable , Functor , Lift , TextShow1 , Traversable #endif ) #if __GLASGOW_HASKELL__ < 800 deriving instance TextShow1 f => TextShow1 (FromTextShow1 f) deriving instance Functor f => Functor (FromTextShow1 f) deriving instance Foldable f => Foldable (FromTextShow1 f) deriving instance Traversable f => Traversable (FromTextShow1 f) # if __GLASGOW_HASKELL__ >= 708 deriving instance Typeable FromTextShow1 deriving instance ( Data (f a), Typeable f, Typeable a ) => Data (FromTextShow1 f (a :: *)) # endif #endif instance Read (f a) => Read (FromTextShow1 f a) where readPrec = coerce (readPrec :: ReadPrec (f a)) readsPrec = coerce (readsPrec :: Int -> ReadS (f a)) readList = coerce (readList :: ReadS [f a]) readListPrec = coerce (readListPrec :: ReadPrec [f a]) #if defined(NEW_FUNCTOR_CLASSES) -- | Not available if using @transformers-0.4@ instance (TextShow1 f, TextShow a) => Show (FromTextShow1 f a) where showsPrec = liftShowsPrec (showbPrecToShowsPrec showbPrec) (showbToShows showbList) showList = liftShowList (showbPrecToShowsPrec showbPrec) (showbToShows showbList) #endif instance TextShow1 f => Show1 (FromTextShow1 f) where #if defined(NEW_FUNCTOR_CLASSES) liftShowList sp sl = showbToShows (liftShowbList (showsPrecToShowbPrec sp) (showsToShowb sl)) . coerceList where coerceList :: [FromTextShow1 f a] -> [f a] coerceList = coerce liftShowsPrec sp sl p #else showsPrec1 p #endif = showbPrecToShowsPrec (liftShowbPrec (showsPrecToShowbPrec sp) (showsToShowb sl)) p . fromTextShow1 instance (TextShow1 f, TextShow a) => TextShow (FromTextShow1 f a) where showbPrec = showbPrec1 showbList = liftShowbList showbPrec showbList ------------------------------------------------------------------------------- -- | The 'TextShow2' instance for 'FromStringShow2' is based on its @String@ -- 'Show2' instance. That is, -- -- @ -- 'liftShowbPrec2' sp1 sl1 sp2 sl2 p ('FromStringShow2' x) = -- 'showsPrecToShowbPrec' ('liftShowsPrec2' ('showbPrecToShowsPrec' sp1) -- ('showbToShows' sl1) -- ('showbPrecToShowsPrec' sp2) -- ('showbToShows' sl2)) -- p x -- @ -- -- /Since: 3/ newtype FromStringShow2 f a b = FromStringShow2 { fromStringShow2 :: f a b } deriving ( Eq , Ord #if __GLASGOW_HASKELL__ >= 706 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #endif #if __GLASGOW_HASKELL__ >= 800 , Data , Foldable , Functor , Lift , Traversable #endif ) #if __GLASGOW_HASKELL__ < 800 deriving instance Functor (f a) => Functor (FromStringShow2 f a) deriving instance Foldable (f a) => Foldable (FromStringShow2 f a) deriving instance Traversable (f a) => Traversable (FromStringShow2 f a) # if __GLASGOW_HASKELL__ >= 708 deriving instance Typeable FromStringShow2 deriving instance ( Data (f a b), Typeable f, Typeable a, Typeable b ) => Data (FromStringShow2 f (a :: *) (b :: *)) # endif #endif instance Read (f a b) => Read (FromStringShow2 f a b) where readPrec = coerce (readPrec :: ReadPrec (f a b)) readsPrec = coerce (readsPrec :: Int -> ReadS (f a b)) readList = coerce (readList :: ReadS [f a b]) readListPrec = coerce (readListPrec :: ReadPrec [f a b]) #if defined(NEW_FUNCTOR_CLASSES) -- TODO: Manually implement this when you can derive Show2 (someday) -- | Not available if using @transformers-0.4@ deriving instance Show2 f => Show2 (FromStringShow2 f) -- | Not available if using @transformers-0.4@ instance (Show2 f, Show a, Show b) => TextShow (FromStringShow2 f a b) where showbPrec = liftShowbPrec (showsPrecToShowbPrec showsPrec) (showsToShowb showList) showbList = liftShowbList (showsPrecToShowbPrec showsPrec) (showsToShowb showList) -- | Not available if using @transformers-0.4@ instance (Show2 f, Show a) => TextShow1 (FromStringShow2 f a) where liftShowbPrec = liftShowbPrec2 (showsPrecToShowbPrec showsPrec) (showsToShowb showList) liftShowbList = liftShowbList2 (showsPrecToShowbPrec showsPrec) (showsToShowb showList) -- | Not available if using @transformers-0.4@ instance Show2 f => TextShow2 (FromStringShow2 f) where liftShowbPrec2 sp1 sl1 sp2 sl2 p = showsPrecToShowbPrec (liftShowsPrec2 (showbPrecToShowsPrec sp1) (showbToShows sl1) (showbPrecToShowsPrec sp2) (showbToShows sl2)) p . fromStringShow2 liftShowbList2 sp1 sl1 sp2 sl2 = showsToShowb (liftShowList2 (showbPrecToShowsPrec sp1) (showbToShows sl1) (showbPrecToShowsPrec sp2) (showbToShows sl2)) . coerceList where coerceList :: [FromStringShow2 f a b] -> [f a b] coerceList = coerce -- | Not available if using @transformers-0.4@ instance (Show2 f, Show a, Show b) => Show (FromStringShow2 f a b) where showsPrec = showsPrec2 showList = liftShowList2 showsPrec showList showsPrec showList -- | Not available if using @transformers-0.4@ instance (Show2 f, Show a) => Show1 (FromStringShow2 f a) where liftShowsPrec = liftShowsPrec2 showsPrec showList liftShowList = liftShowList2 showsPrec showList #endif ------------------------------------------------------------------------------- -- | The @String@ 'Show2' instance for 'FromTextShow2' is based on its -- 'TextShow2' instance. That is, -- -- @ -- liftShowsPrec2 sp1 sl1 sp2 sl2 p ('FromTextShow2' x) = -- 'showbPrecToShowsPrec' ('liftShowbPrec2' ('showsPrecToShowbPrec' sp1) -- ('showsToShowb' sl1) -- ('showsPrecToShowbPrec' sp2) -- ('showsToShowb' sl2)) -- p x -- @ -- -- /Since: 3/ newtype FromTextShow2 f a b = FromTextShow2 { fromTextShow2 :: f a b } deriving ( Eq , Ord #if __GLASGOW_HASKELL__ >= 706 , Generic # if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 # endif #endif #if __GLASGOW_HASKELL__ >= 800 , Data , Foldable , Functor , Lift , TextShow2 , Traversable #endif ) #if __GLASGOW_HASKELL__ < 800 deriving instance TextShow2 f => TextShow2 (FromTextShow2 f) deriving instance Functor (f a) => Functor (FromTextShow2 f a) deriving instance Foldable (f a) => Foldable (FromTextShow2 f a) deriving instance Traversable (f a) => Traversable (FromTextShow2 f a) # if __GLASGOW_HASKELL__ >= 708 deriving instance Typeable FromTextShow2 deriving instance ( Data (f a b), Typeable f, Typeable a, Typeable b ) => Data (FromTextShow2 f (a :: *) (b :: *)) # endif #endif instance Read (f a b) => Read (FromTextShow2 f a b) where readPrec = coerce (readPrec :: ReadPrec (f a b)) readsPrec = coerce (readsPrec :: Int -> ReadS (f a b)) readList = coerce (readList :: ReadS [f a b]) readListPrec = coerce (readListPrec :: ReadPrec [f a b]) #if defined(NEW_FUNCTOR_CLASSES) -- | Not available if using @transformers-0.4@ instance (TextShow2 f, TextShow a, TextShow b) => Show (FromTextShow2 f a b) where showsPrec = liftShowsPrec (showbPrecToShowsPrec showbPrec) (showbToShows showbList) showList = liftShowList (showbPrecToShowsPrec showbPrec) (showbToShows showbList) -- | Not available if using @transformers-0.4@ instance (TextShow2 f, TextShow a) => Show1 (FromTextShow2 f a) where liftShowsPrec = liftShowsPrec2 (showbPrecToShowsPrec showbPrec) (showbToShows showbList) liftShowList = liftShowList2 (showbPrecToShowsPrec showbPrec) (showbToShows showbList) -- | Not available if using @transformers-0.4@ instance TextShow2 f => Show2 (FromTextShow2 f) where liftShowsPrec2 sp1 sl1 sp2 sl2 p = showbPrecToShowsPrec (liftShowbPrec2 (showsPrecToShowbPrec sp1) (showsToShowb sl1) (showsPrecToShowbPrec sp2) (showsToShowb sl2)) p . fromTextShow2 liftShowList2 sp1 sl1 sp2 sl2 = showbToShows (liftShowbList2 (showsPrecToShowbPrec sp1) (showsToShowb sl1) (showsPrecToShowbPrec sp2) (showsToShowb sl2)) . coerceList where coerceList :: [FromTextShow2 f a b] -> [f a b] coerceList = coerce #endif instance (TextShow2 f, TextShow a, TextShow b) => TextShow (FromTextShow2 f a b) where showbPrec = showbPrec2 showbList = liftShowbList2 showbPrec showbList showbPrec showbList instance (TextShow2 f, TextShow a) => TextShow1 (FromTextShow2 f a) where liftShowbPrec = liftShowbPrec2 showbPrec showbList liftShowbList = liftShowbList2 showbPrec showbList ------------------------------------------------------------------------------- #if !defined(NEW_FUNCTOR_CLASSES) liftShowsPrec :: (Show1 f, Show a) => (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS liftShowsPrec _ _ = showsPrec1 liftShowList :: (Show1 f, Show a) => (Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS liftShowList sp' sl' = showListWith (liftShowsPrec sp' sl' 0) sp :: Int -> a -> ShowS sp = undefined sl :: [a] -> ShowS sl = undefined #endif ------------------------------------------------------------------------------- $(deriveBifunctor ''FromStringShow2) $(deriveBifunctor ''FromTextShow2) $(deriveBifoldable ''FromStringShow2) $(deriveBifoldable ''FromTextShow2) $(deriveBitraversable ''FromStringShow2) $(deriveBitraversable ''FromTextShow2) #if __GLASGOW_HASKELL__ < 800 $(deriveLift ''FromStringShow) $(deriveLift ''FromTextShow) instance Lift (f a) => Lift (FromStringShow1 f a) where lift = $(makeLift ''FromStringShow1) instance Lift (f a) => Lift (FromTextShow1 f a) where lift = $(makeLift ''FromTextShow1) instance Lift (f a b) => Lift (FromStringShow2 f a b) where lift = $(makeLift ''FromStringShow2) instance Lift (f a b) => Lift (FromTextShow2 f a b) where lift = $(makeLift ''FromTextShow2) #endif #if !defined(__LANGUAGE_DERIVE_GENERIC1__) $(Generics.deriveMeta ''FromStringShow1) $(Generics.deriveRepresentable1 ''FromStringShow1) $(Generics.deriveMeta ''FromTextShow1) $(Generics.deriveRepresentable1 ''FromTextShow1) $(Generics.deriveMeta ''FromStringShow2) $(Generics.deriveRepresentable1 ''FromStringShow2) $(Generics.deriveMeta ''FromTextShow2) $(Generics.deriveRepresentable1 ''FromTextShow2) #endif #if __GLASGOW_HASKELL__ < 706 $(Generics.deriveAll0And1 ''FromStringShow) $(Generics.deriveAll0And1 ''FromTextShow) $(Generics.deriveRepresentable0 ''FromStringShow1) $(Generics.deriveRepresentable0 ''FromStringShow2) $(Generics.deriveRepresentable0 ''FromTextShow1) $(Generics.deriveRepresentable0 ''FromTextShow2) #endif text-show-3.4/src/TextShow/Text/0000755000000000000000000000000012756060603015015 5ustar0000000000000000text-show-3.4/src/TextShow/Text/Read.hs0000644000000000000000000000305612756060603016230 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Text.Read Copyright: (C) 2014-2016 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-3.4/src/TextShow/GHC/0000755000000000000000000000000012756060603014472 5ustar0000000000000000text-show-3.4/src/TextShow/GHC/Stack.hs0000644000000000000000000000357112756060603016101 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,8,1) {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #endif {-| Module: TextShow.GHC.Stack Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' functions for 'CallStack' and 'SrcLoc' values. This module only exports functions if using @base-4.8.1.0@ or later. /Since: 3.0.1/ -} module TextShow.GHC.Stack ( #if !(MIN_VERSION_base(4,8,1)) ) where #else showbCallStackPrec , showbSrcLocPrec ) where import Data.Text.Lazy.Builder (Builder) import GHC.Stack (CallStack) # if MIN_VERSION_base(4,9,0) import GHC.Stack (SrcLoc, getCallStack) # else import GHC.SrcLoc (SrcLoc) # endif import TextShow.Classes (TextShow(..)) import TextShow.Data.Char () import TextShow.Data.Integral () import TextShow.Data.List () import TextShow.Data.Tuple () import TextShow.TH.Internal (deriveTextShow) -- | Convert a 'CallStack' to a 'Builder' with the given precedence. -- This function is only available with @base-4.8.1.0@ or later. -- With @base-4.9@ or later, this function ignores the precedence argument. -- -- /Since: 3.0.1/ showbCallStackPrec :: Int -> CallStack -> Builder # if MIN_VERSION_base(4,9,0) showbCallStackPrec _ = showb . getCallStack # else showbCallStackPrec = showbPrec # endif {-# INLINE showbCallStackPrec #-} -- | Convert a 'SrcLoc' to a 'Builder' with the given precedence. -- This function is only available with @base-4.8.1.0@ or later. -- -- /Since: 3.0.1/ showbSrcLocPrec :: Int -> SrcLoc -> Builder showbSrcLocPrec = showbPrec {-# INLINE showbSrcLocPrec #-} # if MIN_VERSION_base(4,9,0) instance TextShow CallStack where showb = showbCallStackPrec 0 {-# INLINE showb #-} # else $(deriveTextShow ''CallStack) # endif $(deriveTextShow ''SrcLoc) #endif text-show-3.4/src/TextShow/GHC/TypeLits.hs0000644000000000000000000000665712756060603016621 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-2016 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(..)) # 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-3.4/src/TextShow/GHC/Generics.hs0000644000000000000000000002607212756060603016574 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.GHC.Generics Copyright: (C) 2014-2016 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 , liftShowbPar1Prec , showbRec1Prec , liftShowbRec1Prec , liftShowbK1Prec , showbM1Prec , liftShowbM1Prec , showbSumTypePrec , liftShowbSumTypePrec , showbProductTypePrec , liftShowbProductTypePrec , showbCompFunctorsPrec , liftShowbCompFunctorsPrec , showbFixityPrec , showbAssociativity #if MIN_VERSION_base(4,9,0) , showbSourceUnpackedness , showbSourceStrictness , showbDecidedStrictness #else , showbArityPrec #endif , showbUCharPrec , showbUDoublePrec , showbUFloatPrec , showbUIntPrec , showbUWordPrec ) where import Data.Text.Lazy.Builder (Builder) import Generics.Deriving.Base import TextShow.Classes (TextShow(..), TextShow1(..), TextShow2(..)) import TextShow.Data.Char () import TextShow.Data.Floating () import TextShow.Data.Integral () import TextShow.TH.Internal (deriveTextShow, deriveTextShow1, makeShowbPrec, makeLiftShowbPrec, makeLiftShowbPrec2) #if !(MIN_VERSION_template_haskell(2,7,0)) import Data.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (fromString, singleton) import GHC.Exts (Char(C#), Double(D#), Float(F#), Int(I#), Word(W#)) import GHC.Show (appPrec) import TextShow.Classes (showbParen) #endif -- | 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: 3/ liftShowbPar1Prec :: (Int -> p -> Builder) -> Int -> Par1 p -> Builder liftShowbPar1Prec sp = liftShowbPrec sp undefined {-# INLINE liftShowbPar1Prec #-} -- | Convert a 'Rec1' value to a 'Builder' with the given precedence. -- -- /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: 3/ liftShowbRec1Prec :: TextShow1 f => (Int -> p -> Builder) -> ([p] -> Builder) -> Int -> Rec1 f p -> Builder liftShowbRec1Prec = liftShowbPrec {-# INLINE liftShowbRec1Prec #-} -- | Convert a 'K1' value to a 'Builder' with the given show function and precedence. -- -- /Since: 3/ liftShowbK1Prec :: (Int -> c -> Builder) -> Int -> K1 i c p -> Builder liftShowbK1Prec sp = liftShowbPrec2 sp undefined undefined undefined {-# INLINE liftShowbK1Prec #-} -- | Convert an 'M1' value to a 'Builder' with the given precedence. -- -- /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: 3/ liftShowbM1Prec :: TextShow1 f => (Int -> p -> Builder) -> ([p] -> Builder) -> Int -> M1 i c f p -> Builder liftShowbM1Prec = liftShowbPrec {-# INLINE liftShowbM1Prec #-} -- | Convert a '(:+:)' value to a 'Builder' with the given precedence. -- -- /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: 3/ liftShowbSumTypePrec :: (TextShow1 f, TextShow1 g) => (Int -> p -> Builder) -> ([p] -> Builder) -> Int -> (f :+: g) p -> Builder liftShowbSumTypePrec = liftShowbPrec {-# INLINE liftShowbSumTypePrec #-} -- | Convert a '(:*:)' value to a 'Builder' with the given precedence. -- -- /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: 3/ liftShowbProductTypePrec :: (TextShow1 f, TextShow1 g) => (Int -> p -> Builder) -> ([p] -> Builder) -> Int -> (f :*: g) p -> Builder liftShowbProductTypePrec = liftShowbPrec {-# INLINE liftShowbProductTypePrec #-} -- | Convert a '(:.:)' value to a 'Builder' with the given precedence. -- -- /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. -- -- /Since: 3/ liftShowbCompFunctorsPrec :: (TextShow1 f, TextShow1 g) => (Int -> p -> Builder) -> ([p] -> Builder) -> Int -> (f :.: g) p -> Builder liftShowbCompFunctorsPrec = liftShowbPrec {-# INLINE liftShowbCompFunctorsPrec #-} -- | Convert a 'Fixity' value to a 'Builder' with the given precedence. -- -- /Since: 2/ showbFixityPrec :: Int -> Fixity -> Builder showbFixityPrec = showbPrec {-# INLINE showbFixityPrec #-} -- | Convert an 'Associativity' value to a 'Builder'. -- -- /Since: 2/ showbAssociativity :: Associativity -> Builder showbAssociativity = showb {-# INLINE showbAssociativity #-} #if MIN_VERSION_base(4,9,0) -- | Convert a 'SourceUnpackedness' value to a 'Builder'. -- This function is only available with @base-4.9.0.0@ or later. -- -- /Since: 3/ showbSourceUnpackedness :: SourceUnpackedness -> Builder showbSourceUnpackedness = showb {-# INLINE showbSourceUnpackedness #-} -- | Convert a 'SourceStrictness' value to a 'Builder'. -- This function is only available with @base-4.9.0.0@ or later. -- -- /Since: 3/ showbSourceStrictness :: SourceStrictness -> Builder showbSourceStrictness = showb {-# INLINE showbSourceStrictness #-} -- | Convert a 'DecidedStrictness' value to a 'Builder'. -- This function is only available with @base-4.9.0.0@ or later. -- -- /Since: 3/ showbDecidedStrictness :: DecidedStrictness -> Builder showbDecidedStrictness = showb {-# INLINE showbDecidedStrictness #-} #else -- | Convert an 'Arity' value to a 'Builder' with the given precedence. -- This function is only available with @base-4.8@ or earlier. -- -- /Since: 2/ showbArityPrec :: Int -> Arity -> Builder showbArityPrec = showbPrec {-# INLINE showbArityPrec #-} #endif -- | Convert a 'UChar' to a 'Builder' with the given precedence. -- -- /Since: 2.1.2/ showbUCharPrec :: Int -> UChar p -> Builder showbUCharPrec = showbPrec {-# INLINE showbUCharPrec #-} -- | Convert a 'UDouble' to a 'Builder' with the given precedence. -- -- /Since: 2.1.2/ showbUDoublePrec :: Int -> UDouble p -> Builder showbUDoublePrec = showbPrec {-# INLINE showbUDoublePrec #-} -- | Convert a 'UFloat' to a 'Builder' with the given precedence. -- -- /Since: 2.1.2/ showbUFloatPrec :: Int -> UFloat p -> Builder showbUFloatPrec = showbPrec {-# INLINE showbUFloatPrec #-} -- | Convert a 'UInt' to a 'Builder' with the given precedence. -- -- /Since: 2.1.2/ showbUIntPrec :: Int -> UInt p -> Builder showbUIntPrec = showbPrec {-# INLINE showbUIntPrec #-} -- | Convert a 'UWord' to a 'Builder' with the given precedence. -- -- /Since: 2.1.2/ showbUWordPrec :: Int -> UWord p -> Builder showbUWordPrec = showbPrec {-# INLINE showbUWordPrec #-} instance TextShow (U1 p) where showbPrec = liftShowbPrec undefined 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 = liftShowbPrec undefined undefined instance TextShow c => TextShow1 (K1 i c) where liftShowbPrec = liftShowbPrec2 showbPrec showbList instance TextShow2 (K1 i) where liftShowbPrec2 = $(makeLiftShowbPrec2 ''K1) instance TextShow (f p) => TextShow (M1 i c f p) where showbPrec = $(makeShowbPrec ''M1) instance TextShow1 f => TextShow1 (M1 i c f) where liftShowbPrec = $(makeLiftShowbPrec ''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 ''(:.:)) #if MIN_VERSION_template_haskell(2,7,0) instance TextShow (UChar p) where showbPrec = $(makeShowbPrec 'UChar) $(deriveTextShow1 'UChar) instance TextShow (UDouble p) where showbPrec = $(makeShowbPrec 'UDouble) $(deriveTextShow1 'UDouble) instance TextShow (UFloat p) where showbPrec = $(makeShowbPrec 'UFloat) $(deriveTextShow1 'UFloat) instance TextShow (UInt p) where showbPrec = $(makeShowbPrec 'UInt) $(deriveTextShow1 'UInt) instance TextShow (UWord p) where showbPrec = $(makeShowbPrec 'UWord) $(deriveTextShow1 'UWord) #else instance TextShow (UChar p) where showbPrec = liftShowbPrec undefined undefined instance TextShow1 UChar where liftShowbPrec _ _ p (UChar c) = showbParen (p > appPrec) $ fromString "UChar " <> singleton '{' <> fromString "uChar# = " <> showb (C# c) <> singleton '}' instance TextShow (UDouble p) where showbPrec = liftShowbPrec undefined undefined instance TextShow1 UDouble where liftShowbPrec _ _ p (UDouble d) = showbParen (p > appPrec) $ fromString "UDouble " <> singleton '{' <> fromString "uDouble# = " <> showb (D# d) <> singleton '}' instance TextShow (UFloat p) where showbPrec = liftShowbPrec undefined undefined instance TextShow1 UFloat where liftShowbPrec _ _ p (UFloat f) = showbParen (p > appPrec) $ fromString "UFloat " <> singleton '{' <> fromString "uFloat# = " <> showb (F# f) <> singleton '}' instance TextShow (UInt p) where showbPrec = liftShowbPrec undefined undefined instance TextShow1 UInt where liftShowbPrec _ _ p (UInt i) = showbParen (p > appPrec) $ fromString "UInt " <> singleton '{' <> fromString "uInt# = " <> showb (I# i) <> singleton '}' instance TextShow (UWord p) where showbPrec = liftShowbPrec undefined undefined instance TextShow1 UWord where liftShowbPrec _ _ p (UWord w) = showbParen (p > appPrec) $ fromString "UWord " <> singleton '{' <> fromString "uWord# = " <> showb (W# w) <> singleton '}' #endif $(deriveTextShow ''Fixity) $(deriveTextShow ''Associativity) #if MIN_VERSION_base(4,9,0) $(deriveTextShow ''SourceUnpackedness) $(deriveTextShow ''SourceStrictness) $(deriveTextShow ''DecidedStrictness) #else $(deriveTextShow ''Arity) #endif text-show-3.4/src/TextShow/GHC/StaticPtr.hs0000644000000000000000000000231112756060603016740 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-2016 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) -- | Convert 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-3.4/src/TextShow/GHC/Fingerprint.hs0000644000000000000000000000247512756060603017325 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,4,0) {-# OPTIONS_GHC -fno-warn-orphans #-} #endif {-| Module: TextShow.GHC.Fingerprint Copyright: (C) 2014-2016 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.Semigroup (mtimesDefault) import Data.Text.Lazy.Builder (Builder, singleton) import Data.Word (Word64) import GHC.Fingerprint.Type (Fingerprint(..)) import TextShow.Classes (TextShow(..)) import TextShow.Data.Integral (showbHex) import TextShow.Utils (lengthB) -- | 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-3.4/src/TextShow/GHC/Event.hs0000644000000000000000000000562112756060603016113 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-2016 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(..)) 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-3.4/src/TextShow/GHC/Stats.hs0000644000000000000000000000207612756060603016131 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-2016 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-3.4/src/TextShow/GHC/Conc/0000755000000000000000000000000012756060603015354 5ustar0000000000000000text-show-3.4/src/TextShow/GHC/Conc/Windows.hs0000644000000000000000000000176012756060603017346 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-2016 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-3.4/src/TextShow/GHC/RTS/0000755000000000000000000000000012756060603015142 5ustar0000000000000000text-show-3.4/src/TextShow/GHC/RTS/Flags.hs0000644000000000000000000001302612756060603016534 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-2016 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 __GLASGOW_HASKELL__ >= 801 , showbParFlagsPrec # endif # 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(..)) 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 __GLASGOW_HASKELL__ >= 801 -- | Convert a 'ParFlags' value to a 'Builder' with the given precedence. -- This function is only available with GHC 8.1 or later. -- -- /Since: 3.3/ showbParFlagsPrec :: Int -> ParFlags -> Builder showbParFlagsPrec = showbPrec {-# INLINE showbParFlagsPrec #-} # endif # if MIN_VERSION_base(4,8,2) -- | Convert a 'GiveGCStats' value to a 'Builder'. -- This function is only available with @base-4.8.2.0@ or later. -- -- /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) # if __GLASGOW_HASKELL__ >= 801 $(deriveTextShow ''ParFlags) # endif $(deriveTextShow giveGCStatsTypeName) $(deriveTextShow doCostCentresTypeName) $(deriveTextShow doHeapProfileTypeName) $(deriveTextShow doTraceTypeName) #endif text-show-3.4/src/TextShow/Control/0000755000000000000000000000000012756060603015511 5ustar0000000000000000text-show-3.4/src/TextShow/Control/Concurrent.hs0000644000000000000000000000375512756060603020201 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE UnliftedFFITypes #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Control.Concurrent Copyright: (C) 2014-2016 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(..)) 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-3.4/src/TextShow/Control/Exception.hs0000644000000000000000000002233212756060603020005 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Control.Exception Copyright: (C) 2014-2016 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 #if MIN_VERSION_base(4,9,0) , showbTypeError #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,9,0) import Data.Text.Lazy.Builder (singleton) #endif import Prelude () import Prelude.Compat import TextShow.Classes (TextShow(..)) import TextShow.FromStringTextShow (FromStringShow(..)) import TextShow.TH.Internal (deriveTextShow) #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 #if MIN_VERSION_base(4,9,0) -- | Convert a 'TypeError' to a 'Builder'. -- This function is only available with @base-4.9.0.0@ or later. -- -- /Since: 3/ showbTypeError :: TypeError -> Builder showbTypeError (TypeError err) = fromString err {-# INLINE showbTypeError #-} #endif -- | Convert a 'Deadlock' exception to a 'Builder'. -- -- /Since: 2/ 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,9,0) showbErrorCall (ErrorCallWithLocation err "") = fromString err showbErrorCall (ErrorCallWithLocation err loc) = fromString err <> singleton '\n' <> fromString loc #else showbErrorCall (ErrorCall err) = fromString err #endif -- | Convert a 'MaskingState' to a 'Builder'. -- -- /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 #if MIN_VERSION_base(4,9,0) instance TextShow TypeError where showb = showbTypeError {-# 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-3.4/src/TextShow/Control/Applicative.hs0000644000000000000000000000311212756060603020303 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Control.Applicative Copyright: (C) 2014-2016 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 (liftShowbConstPrec, liftShowbZipListPrec) where import Control.Applicative (Const(..), ZipList) import Data.Text.Lazy.Builder (Builder) import TextShow.Classes (TextShow(..), TextShow1(..), TextShow2(..), showbUnaryWith) import TextShow.Data.List () import TextShow.TH.Internal (deriveTextShow, deriveTextShow1) -- | Convert a 'Const' value to a 'Builder' with the given show function and precedence. -- -- /Since: 3/ liftShowbConstPrec :: (Int -> a -> Builder) -> Int -> Const a b -> Builder liftShowbConstPrec sp = liftShowbPrec2 sp undefined undefined undefined -- | Convert a 'ZipList' to a 'Builder' with the given show function and precedence. -- -- /Since: 3/ liftShowbZipListPrec :: ([a] -> Builder) -> Int -> ZipList a -> Builder liftShowbZipListPrec sl = liftShowbPrec undefined sl instance TextShow a => TextShow (Const a b) where showbPrec = liftShowbPrec undefined undefined instance TextShow a => TextShow1 (Const a) where liftShowbPrec = liftShowbPrec2 showbPrec showbList instance TextShow2 Const where liftShowbPrec2 sp1 _ _ _ p (Const x) = showbUnaryWith sp1 "Const" p x $(deriveTextShow ''ZipList) $(deriveTextShow1 ''ZipList) text-show-3.4/src/TextShow/Control/Monad/0000755000000000000000000000000012756060603016547 5ustar0000000000000000text-show-3.4/src/TextShow/Control/Monad/ST.hs0000644000000000000000000000205012756060603017426 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Control.Monad.ST Copyright: (C) 2014-2016 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(..), 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 = liftShowbPrec undefined undefined 0 INLINE_INST_FUN(showb) instance TextShow1 (ST s) where liftShowbPrec = liftShowbPrec2 undefined undefined INLINE_INST_FUN(liftShowbPrec) instance TextShow2 ST where liftShowbPrec2 _ _ _ _ _ _ = "<>" INLINE_INST_FUN(liftShowbPrec2) text-show-3.4/src/TextShow/Foreign/0000755000000000000000000000000012756060603015462 5ustar0000000000000000text-show-3.4/src/TextShow/Foreign/Ptr.hs0000644000000000000000000000627712756060603016577 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Foreign.Ptr Copyright: (C) 2014-2016 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.Semigroup (mtimesDefault) import Data.Text.Lazy.Builder (Builder, singleton) import Foreign.ForeignPtr (ForeignPtr) import Foreign.Ptr (FunPtr, IntPtr, WordPtr, castFunPtrToPtr) import GHC.ForeignPtr (unsafeForeignPtrToPtr) import GHC.Num (wordToInteger) import GHC.Ptr (Ptr(..)) import GHC.Prim (addr2Int#, int2Word#, unsafeCoerce#) import TextShow.Classes (TextShow(..), TextShow1(..)) import TextShow.Data.Integral (showbHex, showbIntPrec, showbWord) import TextShow.Utils (lengthB) #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 = liftShowbPrec undefined undefined INLINE_INST_FUN(showbPrec) instance TextShow1 Ptr where liftShowbPrec _ _ _ (Ptr a) = padOut . showbHex $ wordToInteger (int2Word# (addr2Int# a)) where padOut :: Builder -> Builder padOut ls = singleton '0' <> singleton 'x' <> mtimesDefault (max 0 $ 2*SIZEOF_HSPTR - lengthB ls) (singleton '0') <> ls instance TextShow (FunPtr a) where showbPrec = liftShowbPrec undefined undefined INLINE_INST_FUN(showbPrec) instance TextShow1 FunPtr where liftShowbPrec _ _ _ = showb . castFunPtrToPtr INLINE_INST_FUN(liftShowbPrec) 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 = liftShowbPrec undefined undefined INLINE_INST_FUN(showbPrec) instance TextShow1 ForeignPtr where liftShowbPrec _ _ _ = showb . unsafeForeignPtrToPtr INLINE_INST_FUN(liftShowbPrec) text-show-3.4/src/TextShow/Foreign/C/0000755000000000000000000000000012756060603015644 5ustar0000000000000000text-show-3.4/src/TextShow/Foreign/C/Types.hs0000644000000000000000000002755412756060603017321 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-2016 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(..)) 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 text-show-3.4/src/TextShow/System/0000755000000000000000000000000012756060603015355 5ustar0000000000000000text-show-3.4/src/TextShow/System/Exit.hs0000644000000000000000000000143012756060603016620 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.System.Exit Copyright: (C) 2014-2016 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-3.4/src/TextShow/System/IO.hs0000644000000000000000000001004412756060603016217 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.System.IO Copyright: (C) 2014-2016 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(..)) 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-3.4/src/TextShow/System/Posix/0000755000000000000000000000000012756060603016457 5ustar0000000000000000text-show-3.4/src/TextShow/System/Posix/Types.hs0000644000000000000000000001761212756060603020126 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.System.Posix.Types Copyright: (C) 2014-2016 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(..)) 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-3.4/src/TextShow/TH/0000755000000000000000000000000012756060603014404 5ustar0000000000000000text-show-3.4/src/TextShow/TH/Names.hs0000644000000000000000000000563112756060603016010 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-| Module: TextShow.TH.Names Copyright: (C) 2014-2016 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) -- | Creates a 'Name' for a value from the "GHC.Event.Internal" module. mkEventName_v :: String -> Name mkEventName_v = mkNameG_v "base" "GHC.Event.Internal" -- | The 'Name' of 'evtClose'. evtCloseValName :: Name evtCloseValName = mkEventName_v "evtClose" -- | The 'Name' of 'eventIs'. eventIsValName :: Name eventIsValName = mkEventName_v "eventIs" -- | The 'Name' of 'FdKey'. fdKeyTypeName :: Name fdKeyTypeName = mkNameG_tc "base" "GHC.Event.Manager" "FdKey" -- | The 'Name' of 'Unique'. uniqueTypeName :: Name uniqueTypeName = mkNameG_tc "base" "GHC.Event.Unique" "Unique" -- | The 'Name' of 'asInt64'. asInt64ValName :: Name asInt64ValName = mkNameG_v "base" "GHC.Event.Unique" "asInt64" #endif #if MIN_VERSION_base(4,6,0) -- | The 'Name' of 'Number'. numberTypeName :: Name # if MIN_VERSION_base(4,7,0) numberTypeName = ''Number # else numberTypeName = mkNameG_tc "base" "Text.Read.Lex" "Number" # endif #endif #if MIN_VERSION_base(4,8,0) -- | The 'Name' of 'GiveGCStats'. giveGCStatsTypeName :: Name # if __GLASGOW_HASKELL__ >= 711 giveGCStatsTypeName = ''GiveGCStats # else giveGCStatsTypeName = mkFlagsName_tc "GiveGCStats" # endif -- | The 'Name' of 'DoCostCentres'. doCostCentresTypeName :: Name # if __GLASGOW_HASKELL__ >= 711 doCostCentresTypeName = ''DoCostCentres # else doCostCentresTypeName = mkFlagsName_tc "DoCostCentres" # endif -- | The 'Name' of 'DoHeapProfile'. doHeapProfileTypeName :: Name # if __GLASGOW_HASKELL__ >= 711 doHeapProfileTypeName = ''DoHeapProfile # else doHeapProfileTypeName = mkFlagsName_tc "DoHeapProfile" # endif -- | The 'Name' of 'DoTrace'. doTraceTypeName :: Name # if __GLASGOW_HASKELL__ >= 711 doTraceTypeName = ''DoTrace # else doTraceTypeName = mkFlagsName_tc "DoTrace" # endif -- | Creates a 'Name' for a type from the "GHC.RTS.Flags" module. # if __GLASGOW_HASKELL__ < 711 mkFlagsName_tc :: String -> Name mkFlagsName_tc = mkNameG_tc "base" "GHC.RTS.Flags" # endif #endif text-show-3.4/src/TextShow/TH/Internal.hs0000644000000000000000000021741112756060603016522 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TemplateHaskell #-} {-| Module: TextShow.TH.Internal Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Functions to mechanically derive 'TextShow', 'TextShow1', or 'TextShow2' instances, or to splice their functions directly into Haskell source code. You need to enable the @TemplateHaskell@ language extension in order to use this module. This implementation is loosely based off of the @Data.Aeson.TH@ module from the @aeson@ library. -} module TextShow.TH.Internal ( -- * 'deriveTextShow' -- $deriveTextShow deriveTextShow -- * 'deriveTextShow1' -- $deriveTextShow1 , deriveTextShow1 -- * 'deriveTextShow2' -- $deriveTextShow2 , deriveTextShow2 -- * @make-@ functions -- $make , makeShowt , makeShowtl , makeShowtPrec , makeShowtlPrec , makeShowtList , makeShowtlList , makeShowb , makeShowbPrec , makeShowbList , makePrintT , makePrintTL , makeHPrintT , makeHPrintTL , makeLiftShowbPrec , makeShowbPrec1 , makeLiftShowbPrec2 , makeShowbPrec2 -- * 'Options' , Options(..) , defaultOptions , GenTextMethods(..) , deriveTextShowOptions , deriveTextShow1Options , deriveTextShow2Options ) where import Control.Monad (liftM, unless, when) #if MIN_VERSION_template_haskell(2,11,0) import Control.Monad ((<=<)) #endif import Data.Foldable.Compat import Data.List.Compat import qualified Data.List.NonEmpty as NE (drop, length, reverse, splitAt) import Data.List.NonEmpty (NonEmpty(..), (<|)) import qualified Data.Map as Map (fromList, findWithDefault, keys, lookup, singleton) import Data.Map (Map) import Data.Maybe import Data.Monoid.Compat ((<>)) import qualified Data.Set as Set import Data.Set (Set) import qualified Data.Text as TS import qualified Data.Text.IO as TS (putStrLn, hPutStrLn) import Data.Text.Lazy (toStrict) import qualified Data.Text.Lazy.Builder as TB import Data.Text.Lazy.Builder (Builder, toLazyText) import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.IO as TL (putStrLn, hPutStrLn) import GHC.Exts (Char(..), Double(..), Float(..), Int(..), Word(..)) #if __GLASGOW_HASKELL__ >= 800 import GHC.Lexeme (startsConSym) #endif import GHC.Prim (Char#, Double#, Float#, Int#, Word#) import GHC.Show (appPrec, appPrec1) import Language.Haskell.TH.Lib import Language.Haskell.TH.Ppr hiding (appPrec) import Language.Haskell.TH.Syntax import Prelude () import Prelude.Compat import TextShow.Classes (TextShow(..), TextShow1(..), TextShow2(..), showbListWith, showbParen, showbSpace, showtParen, showtSpace, showtlParen, showtlSpace) import TextShow.Options (Options(..), GenTextMethods(..), defaultOptions) 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 = deriveTextShowOptions defaultOptions -- | Like 'deriveTextShow', but takes an 'Options' argument. -- -- /Since: 3.4/ deriveTextShowOptions :: Options -> Name -> Q [Dec] deriveTextShowOptions = deriveTextShowClass TextShow {- $deriveTextShow1 'deriveTextShow1' automatically generates a 'Show1' instance declaration for a data type, newtype, or data family instance that has at least one type variable. This emulates what would (hypothetically) happen if you could attach a @deriving 'TextShow1'@ clause to the end of a data declaration. Examples: @ {-# LANGUAGE TemplateHaskell #-} import TextShow.TH data Stream a = Stream a (Stream a) $('deriveTextShow1' ''Stream) -- instance TextShow1 TextStream where ... newtype WrappedFunctor f a = WrapFunctor (f a) $('deriveTextShow1' ''WrappedFunctor) -- instance TextShow1 f => TextShow1 (WrappedFunctor f) where ... @ The same restrictions that apply to 'deriveTextShow' also apply to 'deriveTextShow1', with some caveats: * With 'deriveTextShow1', the last type variable must be of kind @*@. For other ones, type variables of kind @*@ are assumed to require a 'TextShow' context, and type variables of kind @* -> *@ are assumed to require a 'TextShow1' context. For more complicated scenarios, use 'makeLiftShowbPrec'. * If using @-XDatatypeContexts@, a datatype constraint cannot mention the last type variable. For example, @data Ord a => Illegal a = Illegal a@ cannot have a derived 'TextShow1' instance. * If the last type variable is used within a data field of a constructor, it must only be used in the last argument of the data type constructor. For example, @data Legal a = Legal (Either Int a)@ can have a derived 'TextShow1' instance, but @data Illegal a = Illegal (Either a a)@ cannot. * Data family instances must be able to eta-reduce the last type variable. In other words, if you have a instance of the form: @ data family Family a1 ... an t data instance Family e1 ... e2 v = ... @ Then the following conditions must hold: 1. @v@ must be a type variable. 2. @v@ must not be mentioned in any of @e1@, ..., @e2@. -} -- | Generates a 'TextShow1' instance declaration for the given data type or data -- family instance. -- -- /Since: 2/ deriveTextShow1 :: Name -> Q [Dec] deriveTextShow1 = deriveTextShow1Options defaultOptions -- | Like 'deriveTextShow1', but takes an 'Options' argument. -- -- /Since: 3.4/ deriveTextShow1Options :: Options -> Name -> Q [Dec] deriveTextShow1Options = deriveTextShowClass TextShow1 {- $deriveTextShow2 'deriveTextShow2' automatically generates a 'TextShow2' instance declaration for a data type, newtype, or data family instance that has at least two type variables. This emulates what would (hypothetically) happen if you could attach a @deriving 'TextShow2'@ clause to the end of a data declaration. Examples: @ {-# LANGUAGE TemplateHaskell #-} import TextShow.TH data OneOrNone a b = OneL a | OneR b | None $('deriveTextShow2' ''OneOrNone) -- instance TextShow2 OneOrNone where ... newtype WrappedBifunctor f a b = WrapBifunctor (f a b) $('deriveTextShow2' ''WrappedBifunctor) -- instance TextShow2 f => TextShow2 (WrappedBifunctor f) where ... @ The same restrictions that apply to 'deriveTextShow' and 'deriveTextShow1' also apply to 'deriveTextShow2', with some caveats: * With 'deriveTextShow2', the last type variables must both be of kind @*@. For other ones, type variables of kind @*@ are assumed to require a 'TextShow' constraint, type variables of kind @* -> *@ are assumed to require a 'TextShow1' constraint, and type variables of kind @* -> * -> *@ are assumed to require a 'TextShow2' constraint. For more complicated scenarios, use 'makeLiftShowbPrec2'. * If using @-XDatatypeContexts@, a datatype constraint cannot mention either of the last two type variables. For example, @data Ord a => Illegal a b = Illegal a b@ cannot have a derived 'TextShow2' instance. * If either of the last two type variables is used within a data field of a constructor, it must only be used in the last two arguments of the data type constructor. For example, @data Legal a b = Legal (Int, Int, a, b)@ can have a derived 'TextShow2' instance, but @data Illegal a b = Illegal (a, b, a, b)@ cannot. * Data family instances must be able to eta-reduce the last two type variables. In other words, if you have a instance of the form: @ data family Family a1 ... an t1 t2 data instance Family e1 ... e2 v1 v2 = ... @ Then the following conditions must hold: 1. @v1@ and @v2@ must be distinct type variables. 2. Neither @v1@ not @v2@ must be mentioned in any of @e1@, ..., @e2@. -} -- | Generates a 'TextShow2' instance declaration for the given data type or data -- family instance. -- -- /Since: 2/ deriveTextShow2 :: Name -> Q [Dec] deriveTextShow2 = deriveTextShow2Options defaultOptions -- | Like 'deriveTextShow2', but takes an 'Options' argument. -- -- /Since: 3.4/ deriveTextShow2Options :: Options -> Name -> Q [Dec] deriveTextShow2Options = deriveTextShowClass TextShow2 {- $make There may be scenarios in which you want to show an arbitrary data type or data family instance without having to make the type an instance of 'TextShow'. For these cases, this modules provides several functions (all prefixed with @make@-) that splice the appropriate lambda expression into your source code. Example: This is particularly useful for creating instances for sophisticated data types. For example, 'deriveTextShow' cannot infer the correct type context for @newtype HigherKinded f a = HigherKinded (f a)@, since @f@ is of kind @* -> *@. However, it is still possible to derive a 'TextShow' instance for @HigherKinded@ without too much trouble using 'makeShowbPrec': @ {-# LANGUAGE FlexibleContexts, TemplateHaskell #-} import TextShow import TextShow.TH instance TextShow (f a) => TextShow (HigherKinded f a) where showbPrec = $(makeShowbPrec ''HigherKinded) @ -} -- | Generates a lambda expression which behaves like 'showt' (without requiring a -- 'TextShow' instance). -- -- /Since: 2/ makeShowt :: Name -> Q Exp makeShowt name = makeShowtPrec name `appE` integerE 0 -- | Generates a lambda expression which behaves like 'showtl' (without requiring a -- 'TextShow' instance). -- -- /Since: 2/ makeShowtl :: Name -> Q Exp makeShowtl name = makeShowtlPrec name `appE` integerE 0 -- | Generates a lambda expression which behaves like 'showtPrec' (without requiring a -- 'TextShow' instance). -- -- /Since: 2/ makeShowtPrec :: Name -> Q Exp makeShowtPrec = makeShowbPrecClass TextShow ShowtPrec -- | Generates a lambda expression which behaves like 'showtlPrec' (without -- requiring a 'TextShow' instance). -- -- /Since: 2/ makeShowtlPrec :: Name -> Q Exp makeShowtlPrec = makeShowbPrecClass TextShow ShowtlPrec -- | Generates a lambda expression which behaves like 'showtList' (without requiring a -- 'TextShow' instance). -- -- /Since: 2/ makeShowtList :: Name -> Q Exp makeShowtList name = [| toStrict . $(makeShowtlList name) |] -- | Generates a lambda expression which behaves like 'showtlList' (without -- requiring a 'TextShow' instance). -- -- /Since: 2/ makeShowtlList :: Name -> Q Exp makeShowtlList name = [| toLazyText . $(makeShowbList name) |] -- | Generates a lambda expression which behaves like 'showb' (without requiring a -- 'TextShow' instance). -- -- /Since: 2/ makeShowb :: Name -> Q Exp makeShowb name = makeShowbPrec name `appE` integerE 0 -- | Generates a lambda expression which behaves like 'showbPrec' (without requiring a -- 'TextShow' instance). -- -- /Since: 2/ makeShowbPrec :: Name -> Q Exp makeShowbPrec = makeShowbPrecClass TextShow ShowbPrec -- | Generates a lambda expression which behaves like 'liftShowbPrec' (without -- requiring a 'TextShow1' instance). -- -- /Since: 3/ makeLiftShowbPrec :: Name -> Q Exp makeLiftShowbPrec = makeShowbPrecClass TextShow1 ShowbPrec -- | Generates a lambda expression which behaves like 'showbPrec1' (without -- requiring a 'TextShow1' instance). -- -- /Since: 2/ makeShowbPrec1 :: Name -> Q Exp makeShowbPrec1 name = [| $(makeLiftShowbPrec name) showbPrec showbList |] -- | Generates a lambda expression which behaves like 'liftShowbPrec2' (without -- requiring a 'TextShow2' instance). -- -- /Since: 3/ makeLiftShowbPrec2 :: Name -> Q Exp makeLiftShowbPrec2 = makeShowbPrecClass TextShow2 ShowbPrec -- | Generates a lambda expression which behaves like 'showbPrec2' (without -- requiring a 'TextShow2' instance). -- -- /Since: 2/ makeShowbPrec2 :: Name -> Q Exp makeShowbPrec2 name = [| $(makeLiftShowbPrec2 name) showbPrec showbList showbPrec showbList |] -- | Generates a lambda expression which behaves like 'showbList' (without requiring a -- 'TextShow' instance). -- -- /Since: 2/ makeShowbList :: Name -> Q Exp makeShowbList name = [| showbListWith $(makeShowb name) |] -- | Generates a lambda expression which behaves like 'printT' (without requiring a -- 'TextShow' instance). -- -- /Since: 2/ makePrintT :: Name -> Q Exp makePrintT name = [| TS.putStrLn . $(makeShowt name) |] -- | Generates a lambda expression which behaves like 'printTL' (without requiring a -- 'TextShow' instance). -- -- /Since: 2/ makePrintTL :: Name -> Q Exp makePrintTL name = [| TL.putStrLn . $(makeShowtl name) |] -- | Generates a lambda expression which behaves like 'hPrintT' (without requiring a -- 'TextShow' instance). -- -- /Since: 2/ makeHPrintT :: Name -> Q Exp makeHPrintT name = [| \h -> TS.hPutStrLn h . $(makeShowt name) |] -- | Generates a lambda expression which behaves like 'hPrintTL' (without -- requiring a 'TextShow' instance). -- -- /Since: 2/ makeHPrintTL :: Name -> Q Exp makeHPrintTL name = [| \h -> TL.hPutStrLn h . $(makeShowtl name) |] ------------------------------------------------------------------------------- -- Code generation ------------------------------------------------------------------------------- -- | Derive a TextShow(1)(2) instance declaration (depending on the TextShowClass -- argument's value). deriveTextShowClass :: TextShowClass -> Options -> Name -> Q [Dec] deriveTextShowClass tsClass opts name = withType name fromCons where fromCons :: Name -> Cxt -> [TyVarBndr] -> [Con] -> Maybe [Type] -> Q [Dec] fromCons name' ctxt tvbs cons mbTys = (:[]) <$> do (instanceCxt, instanceType) <- buildTypeInstance tsClass name' ctxt tvbs mbTys instanceD (return instanceCxt) (return instanceType) (showbPrecDecs tsClass opts cons) -- | Generates a declaration defining the primary function corresponding to a -- particular class (showbPrec for TextShow, liftShowbPrec for TextShow1, and -- liftShowbPrec2 for TextShow2). showbPrecDecs :: TextShowClass -> Options -> [Con] -> [Q Dec] showbPrecDecs tsClass opts cons = [genMethod ShowbPrec (showbPrecName tsClass)] ++ if tsClass == TextShow && shouldGenTextMethods then [genMethod ShowtPrec 'showtPrec, genMethod ShowtlPrec 'showtlPrec] else [] where shouldGenTextMethods :: Bool shouldGenTextMethods = case genTextMethods opts of AlwaysTextMethods -> True SometimesTextMethods -> all isNullaryCon cons NeverTextMethods -> False genMethod :: TextShowFun -> Name -> Q Dec genMethod method methodName = funD methodName [ clause [] (normalB $ makeTextShowForCons tsClass method cons) [] ] -- | Generates a lambda expression which behaves like showbPrec (for TextShow), -- liftShowbPrec (for TextShow1), or liftShowbPrec2 (for TextShow2). makeShowbPrecClass :: TextShowClass -> TextShowFun -> Name -> Q Exp makeShowbPrecClass tsClass tsFun name = withType name fromCons where fromCons :: Name -> Cxt -> [TyVarBndr] -> [Con] -> Maybe [Type] -> Q Exp fromCons name' ctxt tvbs cons mbTys = -- We force buildTypeInstance here since it performs some checks for whether -- or not the provided datatype can actually have showbPrec/liftShowbPrec/etc. -- implemented for it, and produces errors if it can't. buildTypeInstance tsClass name' ctxt tvbs mbTys `seq` makeTextShowForCons tsClass tsFun cons -- | Generates a lambda expression for showbPrec/liftShowbPrec/etc. for the -- given constructors. All constructors must be from the same type. makeTextShowForCons :: TextShowClass -> TextShowFun -> [Con] -> Q Exp makeTextShowForCons _ _ [] = error "Must have at least one data constructor" makeTextShowForCons tsClass tsFun cons = do p <- newName "p" value <- newName "value" sps <- newNameList "sp" $ fromEnum tsClass sls <- newNameList "sl" $ fromEnum tsClass let spls = zip sps sls spsAndSls = interleave sps sls matches <- concatMapM (makeTextShowForCon p tsClass tsFun spls) cons lamE (map varP $ spsAndSls ++ [p, value]) . appsE $ [ varE $ showPrecConstName tsClass tsFun , caseE (varE value) (map return matches) ] ++ map varE spsAndSls ++ [varE p, varE value] -- | Generates a lambda expression for howbPrec/liftShowbPrec/etc. for a -- single constructor. makeTextShowForCon :: Name -> TextShowClass -> TextShowFun -> [(Name, Name)] -> Con -> Q [Match] makeTextShowForCon _ _ tsFun _ (NormalC conName []) = do m <- match (conP conName []) (normalB $ varE (fromStringName tsFun) `appE` stringE (parenInfixConName conName "")) [] return [m] makeTextShowForCon p tsClass tsFun spls (NormalC conName [_]) = do ([argTy], tvMap) <- reifyConTys tsClass spls conName arg <- newName "arg" let showArg = makeTextShowForArg appPrec1 tsClass tsFun conName tvMap argTy arg namedArg = infixApp (varE (fromStringName tsFun) `appE` stringE (parenInfixConName conName " ")) [| (<>) |] showArg m <- match (conP conName [varP arg]) (normalB $ varE (showParenName tsFun) `appE` infixApp (varE p) [| (>) |] (integerE appPrec) `appE` namedArg) [] return [m] makeTextShowForCon p tsClass tsFun spls (NormalC conName _) = do (argTys, tvMap) <- reifyConTys tsClass spls conName args <- newNameList "arg" $ length argTys m <- if isNonUnitTuple conName then do let showArgs = zipWith (makeTextShowForArg 0 tsClass tsFun conName tvMap) argTys args parenCommaArgs = (varE (singletonName tsFun) `appE` charE '(') : intersperse (varE (singletonName tsFun) `appE` charE ',') showArgs mappendArgs = foldr' (`infixApp` [| (<>) |]) (varE (singletonName tsFun) `appE` charE ')') parenCommaArgs match (conP conName $ map varP args) (normalB mappendArgs) [] else do let showArgs = zipWith (makeTextShowForArg appPrec1 tsClass tsFun conName tvMap) argTys args mappendArgs = foldr1 (\v q -> infixApp v [| (<>) |] (infixApp (varE $ showSpaceName tsFun) [| (<>) |] q)) showArgs namedArgs = infixApp (varE (fromStringName tsFun) `appE` stringE (parenInfixConName conName " ")) [| (<>) |] mappendArgs match (conP conName $ map varP args) (normalB $ varE (showParenName tsFun) `appE` infixApp (varE p) [| (>) |] (integerE appPrec) `appE` namedArgs) [] return [m] makeTextShowForCon p tsClass tsFun spls (RecC conName []) = makeTextShowForCon p tsClass tsFun spls $ NormalC conName [] makeTextShowForCon p tsClass tsFun spls (RecC conName ts) = do (argTys, tvMap) <- reifyConTys tsClass spls conName args <- newNameList "arg" $ length argTys let showArgs = concatMap (\((argName, _, _), argTy, arg) -> [ varE (fromStringName tsFun) `appE` stringE (nameBase argName ++ " = ") , makeTextShowForArg 0 tsClass tsFun conName tvMap argTy arg , varE (fromStringName tsFun) `appE` stringE ", " ] ) (zip3 ts argTys args) braceCommaArgs = (varE (singletonName tsFun) `appE` charE '{') : take (length showArgs - 1) showArgs mappendArgs = foldr' (`infixApp` [| (<>) |]) (varE (singletonName tsFun) `appE` charE '}') braceCommaArgs namedArgs = infixApp (varE (fromStringName tsFun) `appE` stringE (parenInfixConName conName " ")) [| (<>) |] mappendArgs m <- match (conP conName $ map varP args) (normalB $ varE (showParenName tsFun) `appE` infixApp (varE p) [| (>) |] (integerE appPrec) `appE` namedArgs) [] return [m] makeTextShowForCon p tsClass tsFun spls (InfixC _ conName _) = do ([alTy, arTy], tvMap) <- reifyConTys tsClass spls conName al <- newName "argL" ar <- newName "argR" info <- reify conName #if MIN_VERSION_template_haskell(2,11,0) conPrec <- case info of DataConI{} -> do fi <- fromMaybe defaultFixity <$> reifyFixity conName case fi of Fixity prec _ -> return prec #else let conPrec = case info of DataConI _ _ _ (Fixity prec _) -> prec #endif _ -> error $ "TextShow.TH.makeTextShowForCon: Unsupported type: " ++ show info let opName = nameBase conName infixOpE = appE (varE $ fromStringName tsFun) . stringE $ if isInfixTypeCon opName then " " ++ opName ++ " " else " `" ++ opName ++ "` " m <- match (infixP (varP al) conName (varP ar)) (normalB $ (varE (showParenName tsFun) `appE` infixApp (varE p) [| (>) |] (integerE conPrec)) `appE` (infixApp (makeTextShowForArg (conPrec + 1) tsClass tsFun conName tvMap alTy al) [| (<>) |] (infixApp infixOpE [| (<>) |] (makeTextShowForArg (conPrec + 1) tsClass tsFun conName tvMap arTy ar))) ) [] return [m] makeTextShowForCon p tsClass tsFun spls (ForallC _ _ con) = makeTextShowForCon p tsClass tsFun spls con #if MIN_VERSION_template_haskell(2,11,0) makeTextShowForCon p tsClass tsFun spls (GadtC conNames ts _) = let con :: Name -> Q Con con conName = do mbFi <- reifyFixity conName return $ if startsConSym (head $ nameBase conName) && length ts == 2 && isJust mbFi then let [t1, t2] = ts in InfixC t1 conName t2 else NormalC conName ts in concatMapM (makeTextShowForCon p tsClass tsFun spls <=< con) conNames makeTextShowForCon p tsClass tsFun spls (RecGadtC conNames ts _) = concatMapM (makeTextShowForCon p tsClass tsFun spls . flip RecC ts) conNames #endif -- | Generates a lambda expression for howbPrec/liftShowbPrec/etc. for an -- argument of a constructor. makeTextShowForArg :: Int -> TextShowClass -> TextShowFun -> Name -> TyVarMap -> Type -> Name -> Q Exp makeTextShowForArg p _ tsFun _ _ (ConT tyName) tyExpName = showE where tyVarE, showPrecE :: Q Exp tyVarE = varE tyExpName showPrecE = varE (showPrecName TextShow tsFun) showE :: Q Exp showE | tyName == ''Char# = showPrimE 'C# oneHashE | tyName == ''Double# = showPrimE 'D# twoHashE | tyName == ''Float# = showPrimE 'F# oneHashE | tyName == ''Int# = showPrimE 'I# oneHashE | tyName == ''Word# = showPrimE 'W# twoHashE | otherwise = showPrecE `appE` integerE p `appE` tyVarE -- Starting with GHC 7.10, data types containing unlifted types with derived Show -- instances show hashed literals with actual hash signs, and negative hashed -- literals are not surrounded with parentheses. showPrimE :: Name -> Q Exp -> Q Exp showPrimE con _hashE #if __GLASGOW_HASKELL__ >= 711 = infixApp (showPrecE `appE` integerE 0 `appE` (conE con `appE` tyVarE)) [| (<>) |] _hashE #else = showPrecE `appE` integerE p `appE` (conE con `appE` tyVarE) #endif oneHashE, twoHashE :: Q Exp oneHashE = varE (singletonName tsFun) `appE` charE '#' twoHashE = varE (fromStringName tsFun) `appE` stringE "##" makeTextShowForArg p tsClass tsFun conName tvMap ty tyExpName = [| $(makeTextShowForType tsClass tsFun conName tvMap False ty) p $(varE tyExpName) |] -- | Generates a lambda expression for howbPrec/liftShowbPrec/etc. for a -- specific type. The generated expression depends on the number of type variables. -- -- 1. If the type is of kind * (T), apply showbPrec. -- 2. If the type is of kind * -> * (T a), apply liftShowbPrec $(makeTextShowForType a) -- 3. If the type is of kind * -> * -> * (T a b), apply -- liftShowbPrec2 $(makeTextShowForType a) $(makeTextShowForType b) makeTextShowForType :: TextShowClass -> TextShowFun -> Name -> TyVarMap -> Bool -- ^ True if we are using the function of type ([a] -> Builder), -- False if we are using the function of type (Int -> a -> Builder). -> Type -> Q Exp makeTextShowForType _ tsFun _ tvMap sl (VarT tyName) = varE $ case Map.lookup tyName tvMap of Just (spExp, slExp) -> if sl then slExp else spExp Nothing -> if sl then showListName TextShow tsFun else showPrecName TextShow tsFun makeTextShowForType tsClass tsFun conName tvMap sl (SigT ty _) = makeTextShowForType tsClass tsFun conName tvMap sl ty makeTextShowForType tsClass tsFun conName tvMap sl (ForallT _ _ ty) = makeTextShowForType tsClass tsFun conName tvMap sl ty makeTextShowForType tsClass tsFun conName tvMap sl ty = do let tyCon :: Type tyArgs :: [Type] tyCon :| tyArgs = unapplyTy ty numLastArgs :: Int numLastArgs = min (fromEnum tsClass) (length tyArgs) lhsArgs, rhsArgs :: [Type] (lhsArgs, rhsArgs) = splitAt (length tyArgs - numLastArgs) tyArgs tyVarNames :: [Name] tyVarNames = Map.keys tvMap itf <- isTyFamily tyCon if any (`mentionsName` tyVarNames) lhsArgs || itf && any (`mentionsName` tyVarNames) tyArgs then outOfPlaceTyVarError tsClass conName else if any (`mentionsName` tyVarNames) rhsArgs then appsE $ [ varE $ showPrecOrListName sl (toEnum numLastArgs) tsFun] ++ zipWith (makeTextShowForType tsClass tsFun conName tvMap) (cycle [False,True]) (interleave rhsArgs rhsArgs) else varE $ if sl then showListName TextShow tsFun else showPrecName TextShow tsFun ------------------------------------------------------------------------------- -- Template Haskell reifying and AST manipulation ------------------------------------------------------------------------------- -- | Extracts a plain type constructor's information. -- | Boilerplate for top level splices. -- -- The given Name must meet one of two criteria: -- -- 1. It must be the name of a type constructor of a plain data type or newtype. -- 2. It must be the name of a data family instance or newtype instance constructor. -- -- Any other value will result in an exception. withType :: Name -> (Name -> Cxt -> [TyVarBndr] -> [Con] -> Maybe [Type] -> Q a) -> Q a withType name f = do info <- reify name case info of TyConI dec -> case dec of DataD ctxt _ tvbs #if MIN_VERSION_template_haskell(2,11,0) _ #endif cons _ -> f name ctxt tvbs cons Nothing NewtypeD ctxt _ tvbs #if MIN_VERSION_template_haskell(2,11,0) _ #endif con _ -> f name ctxt tvbs [con] Nothing _ -> error $ ns ++ "Unsupported type: " ++ show dec #if MIN_VERSION_template_haskell(2,7,0) # if MIN_VERSION_template_haskell(2,11,0) DataConI _ _ parentName -> do # else DataConI _ _ parentName _ -> do # endif parentInfo <- reify parentName case parentInfo of # if MIN_VERSION_template_haskell(2,11,0) FamilyI (DataFamilyD _ tvbs _) decs -> # else FamilyI (FamilyD DataFam _ tvbs _) decs -> # endif let instDec = flip find decs $ \dec -> case dec of DataInstD _ _ _ # if MIN_VERSION_template_haskell(2,11,0) _ # endif cons _ -> any ((name ==) . constructorName) cons NewtypeInstD _ _ _ # if MIN_VERSION_template_haskell(2,11,0) _ # endif con _ -> name == constructorName con _ -> error $ ns ++ "Must be a data or newtype instance." in case instDec of Just (DataInstD ctxt _ instTys # if MIN_VERSION_template_haskell(2,11,0) _ # endif cons _) -> f parentName ctxt tvbs cons $ Just instTys Just (NewtypeInstD ctxt _ instTys # if MIN_VERSION_template_haskell(2,11,0) _ # endif con _) -> f parentName ctxt tvbs [con] $ Just instTys _ -> error $ ns ++ "Could not find data or newtype instance constructor." _ -> error $ ns ++ "Data constructor " ++ show name ++ " is not from a data family instance constructor." # if MIN_VERSION_template_haskell(2,11,0) FamilyI DataFamilyD{} _ -> # else FamilyI (FamilyD DataFam _ _ _) _ -> # endif error $ ns ++ "Cannot use a data family name. Use a data family instance constructor instead." _ -> error $ ns ++ "The name must be of a plain data type constructor, " ++ "or a data family instance constructor." #else DataConI{} -> dataConIError _ -> error $ ns ++ "The name must be of a plain type constructor." #endif where ns :: String ns = "TextShow.TH.withType: " -- | Deduces the instance context and head for an instance. buildTypeInstance :: TextShowClass -- ^ TextShow, TextShow1, or TextShow2 -> Name -- ^ The type constructor or data family name -> Cxt -- ^ The datatype context -> [TyVarBndr] -- ^ The type variables from the data type/data family declaration -> Maybe [Type] -- ^ 'Just' the types used to instantiate a data family instance, -- or 'Nothing' if it's a plain data type -> Q (Cxt, Type) -- Plain data type/newtype case buildTypeInstance tsClass tyConName dataCxt tvbs Nothing = let varTys :: [Type] varTys = map tvbToType tvbs in buildTypeInstanceFromTys tsClass tyConName dataCxt varTys False -- Data family instance case -- -- The CPP is present to work around a couple of annoying old GHC bugs. -- See Note [Polykinded data families in Template Haskell] buildTypeInstance tsClass parentName dataCxt tvbs (Just instTysAndKinds) = do #if !(MIN_VERSION_template_haskell(2,8,0)) || MIN_VERSION_template_haskell(2,10,0) let instTys :: [Type] instTys = zipWith stealKindForType tvbs instTysAndKinds #else let kindVarNames :: [Name] kindVarNames = nub $ concatMap (tyVarNamesOfType . tvbKind) tvbs numKindVars :: Int numKindVars = length kindVarNames givenKinds, givenKinds' :: [Kind] givenTys :: [Type] (givenKinds, givenTys) = splitAt numKindVars instTysAndKinds givenKinds' = map sanitizeStars givenKinds -- A GHC 7.6-specific bug requires us to replace all occurrences of -- (ConT GHC.Prim.*) with StarT, or else Template Haskell will reject it. -- Luckily, (ConT GHC.Prim.*) only seems to occur in this one spot. sanitizeStars :: Kind -> Kind sanitizeStars = go where go :: Kind -> Kind go (AppT t1 t2) = AppT (go t1) (go t2) go (SigT t k) = SigT (go t) (go k) go (ConT n) | n == starKindName = StarT go t = t -- It's quite awkward to import * from GHC.Prim, so we'll just -- hack our way around it. starKindName :: Name starKindName = mkNameG_tc "ghc-prim" "GHC.Prim" "*" -- If we run this code with GHC 7.8, we might have to generate extra type -- variables to compensate for any type variables that Template Haskell -- eta-reduced away. -- See Note [Polykinded data families in Template Haskell] xTypeNames <- newNameList "tExtra" (length tvbs - length givenTys) let xTys :: [Type] xTys = map VarT xTypeNames -- ^ Because these type variables were eta-reduced away, we can only -- determine their kind by using stealKindForType. Therefore, we mark -- them as VarT to ensure they will be given an explicit kind annotation -- (and so the kind inference machinery has the right information). substNamesWithKinds :: [(Name, Kind)] -> Type -> Type substNamesWithKinds nks t = foldr' (uncurry substNameWithKind) t nks -- The types from the data family instance might not have explicit kind -- annotations, which the kind machinery needs to work correctly. To -- compensate, we use stealKindForType to explicitly annotate any -- types without kind annotations. instTys :: [Type] instTys = map (substNamesWithKinds (zip kindVarNames givenKinds')) -- ^ Note that due to a GHC 7.8-specific bug -- (see Note [Polykinded data families in Template Haskell]), -- there may be more kind variable names than there are kinds -- to substitute. But this is OK! If a kind is eta-reduced, it -- means that is was not instantiated to something more specific, -- so we need not substitute it. Using stealKindForType will -- grab the correct kind. $ zipWith stealKindForType tvbs (givenTys ++ xTys) #endif buildTypeInstanceFromTys tsClass parentName dataCxt instTys True -- For the given Types, generate an instance context and head. Coming up with -- the instance type isn't as simple as dropping the last types, as you need to -- be wary of kinds being instantiated with *. -- See Note [Type inference in derived instances] buildTypeInstanceFromTys :: TextShowClass -- ^ TextShow, TextShow1, or TextShow2 -> Name -- ^ The type constructor or data family name -> Cxt -- ^ The datatype context -> [Type] -- ^ The types to instantiate the instance with -> Bool -- ^ True if it's a data family, False otherwise -> Q (Cxt, Type) buildTypeInstanceFromTys tsClass tyConName dataCxt varTysOrig isDataFamily = do -- Make sure to expand through type/kind synonyms! Otherwise, the -- eta-reduction check might get tripped up over type variables in a -- synonym that are actually dropped. -- (See GHC Trac #11416 for a scenario where this actually happened.) varTysExp <- mapM expandSyn varTysOrig let remainingLength :: Int remainingLength = length varTysOrig - fromEnum tsClass droppedTysExp :: [Type] droppedTysExp = drop remainingLength varTysExp droppedStarKindStati :: [StarKindStatus] droppedStarKindStati = map canRealizeKindStar droppedTysExp -- Check there are enough types to drop and that all of them are either of -- kind * or kind k (for some kind variable k). If not, throw an error. when (remainingLength < 0 || any (== NotKindStar) droppedStarKindStati) $ derivingKindError tsClass tyConName let droppedKindVarNames :: [Name] droppedKindVarNames = catKindVarNames droppedStarKindStati -- Substitute kind * for any dropped kind variables varTysExpSubst :: [Type] varTysExpSubst = map (substNamesWithKindStar droppedKindVarNames) varTysExp remainingTysExpSubst, droppedTysExpSubst :: [Type] (remainingTysExpSubst, droppedTysExpSubst) = splitAt remainingLength varTysExpSubst -- All of the type variables mentioned in the dropped types -- (post-synonym expansion) droppedTyVarNames :: [Name] droppedTyVarNames = concatMap tyVarNamesOfType droppedTysExpSubst -- If any of the dropped types were polykinded, ensure that they are of kind * -- after substituting * for the dropped kind variables. If not, throw an error. unless (all hasKindStar droppedTysExpSubst) $ derivingKindError tsClass tyConName let preds :: [Maybe Pred] kvNames :: [[Name]] kvNames' :: [Name] -- Derive instance constraints (and any kind variables which are specialized -- to * in those constraints) (preds, kvNames) = unzip $ map (deriveConstraint tsClass) remainingTysExpSubst kvNames' = concat kvNames -- Substitute the kind variables specialized in the constraints with * remainingTysExpSubst' :: [Type] remainingTysExpSubst' = map (substNamesWithKindStar kvNames') remainingTysExpSubst -- We now substitute all of the specialized-to-* kind variable names with -- *, but in the original types, not the synonym-expanded types. The reason -- we do this is a superficial one: we want the derived instance to resemble -- the datatype written in source code as closely as possible. For example, -- for the following data family instance: -- -- data family Fam a -- newtype instance Fam String = Fam String -- -- We'd want to generate the instance: -- -- instance C (Fam String) -- -- Not: -- -- instance C (Fam [Char]) remainingTysOrigSubst :: [Type] remainingTysOrigSubst = map (substNamesWithKindStar (union droppedKindVarNames kvNames')) $ take remainingLength varTysOrig remainingTysOrigSubst' :: [Type] -- See Note [Kind signatures in derived instances] for an explanation -- of the isDataFamily check. remainingTysOrigSubst' = if isDataFamily then remainingTysOrigSubst else map unSigT remainingTysOrigSubst instanceCxt :: Cxt instanceCxt = catMaybes preds instanceType :: Type instanceType = AppT (ConT $ textShowClassName tsClass) $ applyTyCon tyConName remainingTysOrigSubst' -- If the datatype context mentions any of the dropped type variables, -- we can't derive an instance, so throw an error. when (any (`predMentionsName` droppedTyVarNames) dataCxt) $ datatypeContextError tyConName instanceType -- Also ensure the dropped types can be safely eta-reduced. Otherwise, -- throw an error. unless (canEtaReduce remainingTysExpSubst' droppedTysExpSubst) $ etaReductionError instanceType return (instanceCxt, instanceType) -- | Attempt to derive a constraint on a Type. If successful, return -- Just the constraint and any kind variable names constrained to *. -- Otherwise, return Nothing and the empty list. -- -- See Note [Type inference in derived instances] for the heuristics used to -- come up with constraints. deriveConstraint :: TextShowClass -> Type -> (Maybe Pred, [Name]) deriveConstraint tsClass t | not (isTyVar t) = (Nothing, []) | hasKindStar t = (Just (applyClass ''TextShow tName), []) | otherwise = case hasKindVarChain 1 t of Just ns | tsClass >= TextShow1 -> (Just (applyClass ''TextShow1 tName), ns) _ -> case hasKindVarChain 2 t of Just ns | tsClass == TextShow2 -> (Just (applyClass ''TextShow2 tName), ns) _ -> (Nothing, []) where tName :: Name tName = varTToName t {- Note [Polykinded data families in Template Haskell] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In order to come up with the correct instance context and head for an instance, e.g., instance C a => C (Data a) where ... We need to know the exact types and kinds used to instantiate the instance. For plain old datatypes, this is simple: every type must be a type variable, and Template Haskell reliably tells us the type variables and their kinds. Doing the same for data families proves to be much harder for three reasons: 1. On any version of Template Haskell, it may not tell you what an instantiated type's kind is. For instance, in the following data family instance: data family Fam (f :: * -> *) (a :: *) data instance Fam f a Then if we use TH's reify function, it would tell us the TyVarBndrs of the data family declaration are: [KindedTV f (AppT (AppT ArrowT StarT) StarT),KindedTV a StarT] and the instantiated types of the data family instance are: [VarT f1,VarT a1] We can't just pass [VarT f1,VarT a1] to buildTypeInstanceFromTys, since we have no way of knowing their kinds. Luckily, the TyVarBndrs tell us what the kind is in case an instantiated type isn't a SigT, so we use the stealKindForType function to ensure all of the instantiated types are SigTs before passing them to buildTypeInstanceFromTys. 2. On GHC 7.6 and 7.8, a bug is present in which Template Haskell lists all of the specified kinds of a data family instance efore any of the instantiated types. Fortunately, this is easy to deal with: you simply count the number of distinct kind variables in the data family declaration, take that many elements from the front of the Types list of the data family instance, substitute the kind variables with their respective instantiated kinds (which you took earlier), and proceed as normal. 3. On GHC 7.8, an even uglier bug is present (GHC Trac #9692) in which Template Haskell might not even list all of the Types of a data family instance, since they are eta-reduced away! And yes, kinds can be eta-reduced too. The simplest workaround is to count how many instantiated types are missing from the list and generate extra type variables to use in their place. Luckily, we needn't worry much if its kind was eta-reduced away, since using stealKindForType will get it back. Note [Kind signatures in derived instances] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It is possible to put explicit kind signatures into the derived instances, e.g., instance C a => C (Data (f :: * -> *)) where ... But it is preferable to avoid this if possible. If we come up with an incorrect kind signature (which is entirely possible, since our type inferencer is pretty unsophisticated - see Note [Type inference in derived instances]), then GHC will flat-out reject the instance, which is quite unfortunate. Plain old datatypes have the advantage that you can avoid using any kind signatures at all in their instances. This is because a datatype declaration uses all type variables, so the types that we use in a derived instance uniquely determine their kinds. As long as we plug in the right types, the kind inferencer can do the rest of the work. For this reason, we use unSigT to remove all kind signatures before splicing in the instance context and head. Data family instances are trickier, since a data family can have two instances that are distinguished by kind alone, e.g., data family Fam (a :: k) data instance Fam (a :: * -> *) data instance Fam (a :: *) If we dropped the kind signatures for C (Fam a), then GHC will have no way of knowing which instance we are talking about. To avoid this scenario, we always include explicit kind signatures in data family instances. There is a chance that the inferred kind signatures will be incorrect, but if so, we can always fall back on the make- functions. Note [Type inference in derived instances] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Type inference is can be tricky to get right, and we want to avoid recreating the entirety of GHC's type inferencer in Template Haskell. For this reason, we will probably never come up with derived instance contexts that are as accurate as GHC's. But that doesn't mean we can't do anything! There are a couple of simple things we can do to make instance contexts that work for 80% of use cases: 1. If one of the last type parameters is polykinded, then its kind will be specialized to * in the derived instance. We note what kind variable the type parameter had and substitute it with * in the other types as well. For example, imagine you had data Data (a :: k) (b :: k) Then you'd want to derived instance to be: instance C (Data (a :: *)) Not: instance C (Data (a :: k)) 2. We naïvely come up with instance constraints using the following criteria: (i) If there's a type parameter n of kind *, generate a TextShow n constraint. (ii) If there's a type parameter n of kind k1 -> k2 (where k1/k2 are * or kind variables), then generate a TextShow1 n constraint, and if k1/k2 are kind variables, then substitute k1/k2 with * elsewhere in the types. We must consider the case where they are kind variables because you might have a scenario like this: newtype Compose (f :: k2 -> *) (g :: k1 -> k2) (a :: k1) = Compose (f (g a)) Which would have a derived TextShow1 instance of: instance (TextShow1 f, TextShow1 g) => TextShow1 (Compose f g) where ... (iii) If there's a type parameter n of kind k1 -> k2 -> k3 (where k1/k2/k3 are * or kind variables), then generate a TextShow2 constraint and perform kind substitution as in the other cases. -} ------------------------------------------------------------------------------- -- Error messages ------------------------------------------------------------------------------- -- | Either the given data type doesn't have enough type variables, or one of -- the type variables to be eta-reduced cannot realize kind *. derivingKindError :: TextShowClass -> Name -> a derivingKindError tsClass tyConName = error . showString "Cannot derive well-kinded instance of form ‘" . showString className . showChar ' ' . showParen True ( showString (nameBase tyConName) . showString " ..." ) . showString "‘\n\tClass " . showString className . showString " expects an argument of kind " . showString (pprint . createKindChain $ fromEnum tsClass) $ "" where className :: String className = nameBase $ textShowClassName tsClass -- | One of the last type variables cannot be eta-reduced (see the canEtaReduce -- function for the criteria it would have to meet). etaReductionError :: Type -> a etaReductionError instanceType = error $ "Cannot eta-reduce to an instance of form \n\tinstance (...) => " ++ pprint instanceType -- | The data type has a DatatypeContext which mentions one of the eta-reduced -- type variables. datatypeContextError :: Name -> Type -> a datatypeContextError dataName instanceType = error . showString "Can't make a derived instance of ‘" . showString (pprint instanceType) . showString "‘:\n\tData type ‘" . showString (nameBase dataName) . showString "‘ must not have a class context involving the last type argument(s)" $ "" -- | The data type mentions one of the n eta-reduced type variables in a place other -- than the last nth positions of a data type in a constructor's field. outOfPlaceTyVarError :: TextShowClass -> Name -> a outOfPlaceTyVarError tsClass conName = error . showString "Constructor ‘" . showString (nameBase conName) . showString "‘ must only use its last " . shows n . showString " type variable(s) within the last " . shows n . showString " argument(s) of a data type" $ "" where n :: Int n = fromEnum tsClass #if !(MIN_VERSION_template_haskell(2,7,0)) -- | Template Haskell didn't list all of a data family's instances upon reification -- until template-haskell-2.7.0.0, which is necessary for a derived TextShow(1)(2) -- instance to work. dataConIError :: a dataConIError = error . showString "Cannot use a data constructor." . showString "\n\t(Note: if you are trying to derive TextShow for a" . showString "\n\ttype family, use GHC >= 7.4 instead.)" $ "" #endif ------------------------------------------------------------------------------- -- Expanding type synonyms ------------------------------------------------------------------------------- -- | Expands all type synonyms in a type. Written by Dan Rosén in the -- @genifunctors@ package (licensed under BSD3). expandSyn :: Type -> Q Type expandSyn (ForallT tvs ctx t) = fmap (ForallT tvs ctx) $ expandSyn t expandSyn t@AppT{} = expandSynApp t [] expandSyn t@ConT{} = expandSynApp t [] expandSyn (SigT t k) = do t' <- expandSyn t k' <- expandSynKind k return (SigT t' k') expandSyn t = return t expandSynKind :: Kind -> Q Kind #if MIN_VERSION_template_haskell(2,8,0) expandSynKind = expandSyn #else expandSynKind = return -- There are no kind synonyms to deal with #endif expandSynApp :: Type -> [Type] -> Q Type expandSynApp (AppT t1 t2) ts = do t2' <- expandSyn t2 expandSynApp t1 (t2':ts) expandSynApp (ConT n) ts | nameBase n == "[]" = return $ foldl' AppT ListT ts expandSynApp t@(ConT n) ts = do info <- reify n case info of TyConI (TySynD _ tvs rhs) -> let (ts', ts'') = splitAt (length tvs) ts subs = mkSubst tvs ts' rhs' = substType subs rhs in expandSynApp rhs' ts'' _ -> return $ foldl' AppT t ts expandSynApp t ts = do t' <- expandSyn t return $ foldl' AppT t' ts type TypeSubst = Map Name Type type KindSubst = Map Name Kind mkSubst :: [TyVarBndr] -> [Type] -> TypeSubst mkSubst vs ts = let vs' = map un vs un (PlainTV v) = v un (KindedTV v _) = v in Map.fromList $ zip vs' ts substType :: TypeSubst -> Type -> Type substType subs (ForallT v c t) = ForallT v c $ substType subs t substType subs t@(VarT n) = Map.findWithDefault t n subs substType subs (AppT t1 t2) = AppT (substType subs t1) (substType subs t2) substType subs (SigT t k) = SigT (substType subs t) #if MIN_VERSION_template_haskell(2,8,0) (substType subs k) #else k #endif substType _ t = t substKind :: KindSubst -> Type -> Type #if MIN_VERSION_template_haskell(2,8,0) substKind = substType #else substKind _ = id -- There are no kind variables! #endif substNameWithKind :: Name -> Kind -> Type -> Type substNameWithKind n k = substKind (Map.singleton n k) substNamesWithKindStar :: [Name] -> Type -> Type substNamesWithKindStar ns t = foldr' (flip substNameWithKind starK) t ns ------------------------------------------------------------------------------- -- Class-specific constants ------------------------------------------------------------------------------- -- | A representation of which TextShow variant is being derived. data TextShowClass = TextShow | TextShow1 | TextShow2 deriving (Enum, Eq, Ord) -- | A representation of which TextShow method is being used to -- implement something. data TextShowFun = ShowbPrec | ShowtPrec | ShowtlPrec fromStringName :: TextShowFun -> Name fromStringName ShowbPrec = 'TB.fromString fromStringName ShowtPrec = 'TS.pack fromStringName ShowtlPrec = 'TL.pack singletonName :: TextShowFun -> Name singletonName ShowbPrec = 'TB.singleton singletonName ShowtPrec = 'TS.singleton singletonName ShowtlPrec = 'TL.singleton showParenName :: TextShowFun -> Name showParenName ShowbPrec = 'showbParen showParenName ShowtPrec = 'showtParen showParenName ShowtlPrec = 'showtlParen showSpaceName :: TextShowFun -> Name showSpaceName ShowbPrec = 'showbSpace showSpaceName ShowtPrec = 'showtSpace showSpaceName ShowtlPrec = 'showtlSpace showPrecConstName :: TextShowClass -> TextShowFun -> Name showPrecConstName tsClass ShowbPrec = showbPrecConstName tsClass showPrecConstName TextShow ShowtPrec = 'showtPrecConst showPrecConstName TextShow ShowtlPrec = 'showtlPrecConst showPrecConstName _ _ = error "showPrecConstName" showbPrecConstName :: TextShowClass -> Name showbPrecConstName TextShow = 'showbPrecConst showbPrecConstName TextShow1 = 'liftShowbPrecConst showbPrecConstName TextShow2 = 'liftShowbPrec2Const textShowClassName :: TextShowClass -> Name textShowClassName TextShow = ''TextShow textShowClassName TextShow1 = ''TextShow1 textShowClassName TextShow2 = ''TextShow2 showPrecName :: TextShowClass -> TextShowFun -> Name showPrecName tsClass ShowbPrec = showbPrecName tsClass showPrecName TextShow ShowtPrec = 'showtPrec showPrecName TextShow ShowtlPrec = 'showtlPrec showPrecName _ _ = error "showPrecName" showbPrecName :: TextShowClass -> Name showbPrecName TextShow = 'showbPrec showbPrecName TextShow1 = 'liftShowbPrec showbPrecName TextShow2 = 'liftShowbPrec2 showListName :: TextShowClass -> TextShowFun -> Name showListName tsClass ShowbPrec = showbListName tsClass showListName TextShow ShowtPrec = 'showtPrec showListName TextShow ShowtlPrec = 'showtlPrec showListName _ _ = error "showListName" showbListName :: TextShowClass -> Name showbListName TextShow = 'showbList showbListName TextShow1 = 'liftShowbList showbListName TextShow2 = 'liftShowbList2 showPrecOrListName :: Bool -- ^ showbListName if True, showbPrecName if False -> TextShowClass -> TextShowFun -> Name showPrecOrListName False = showPrecName showPrecOrListName True = showListName -- | A type-restricted version of 'const'. This is useful when generating the lambda -- expression in 'makeShowbPrec' for a data type with only nullary constructors (since -- the expression wouldn't depend on the precedence). For example, if you had @data -- Nullary = Nullary@ and attempted to run @$(makeShowbPrec ''Nullary) Nullary@, simply -- ignoring the precedence argument would cause the type signature of @$(makeShowbPrec -- ''Nullary)@ to be @a -> Nullary -> Builder@, not @Int -> Nullary -> Builder@. showbPrecConst :: Builder -> Int -> a -> Builder showbPrecConst b _ _ = b showtPrecConst :: TS.Text -> Int -> a -> TS.Text showtPrecConst t _ _ = t showtlPrecConst :: TL.Text -> Int -> a -> TL.Text showtlPrecConst tl _ _ = tl liftShowbPrecConst :: Builder -> (Int -> a -> Builder) -> ([a] -> Builder) -> Int -> f a -> Builder liftShowbPrecConst b _ _ _ _ = b liftShowbPrec2Const :: Builder -> (Int -> a -> Builder) -> ([a] -> Builder) -> (Int -> b -> Builder) -> ([b] -> Builder) -> Int -> f a b -> Builder liftShowbPrec2Const b _ _ _ _ _ _ = b ------------------------------------------------------------------------------- -- StarKindStatus ------------------------------------------------------------------------------- -- | Whether a type is not of kind *, is of kind *, or is a kind variable. data StarKindStatus = NotKindStar | KindStar | IsKindVar Name deriving Eq -- | Does a Type have kind * or k (for some kind variable k)? canRealizeKindStar :: Type -> StarKindStatus canRealizeKindStar t | hasKindStar t = KindStar | otherwise = case t of #if MIN_VERSION_template_haskell(2,8,0) SigT _ (VarT k) -> IsKindVar k #endif _ -> NotKindStar -- | Returns 'Just' the kind variable 'Name' of a 'StarKindStatus' if it exists. -- Otherwise, returns 'Nothing'. starKindStatusToName :: StarKindStatus -> Maybe Name starKindStatusToName (IsKindVar n) = Just n starKindStatusToName _ = Nothing -- | Concat together all of the StarKindStatuses that are IsKindVar and extract -- the kind variables' Names out. catKindVarNames :: [StarKindStatus] -> [Name] catKindVarNames = mapMaybe starKindStatusToName ------------------------------------------------------------------------------- -- Assorted utilities ------------------------------------------------------------------------------- integerE :: Int -> Q Exp integerE = litE . integerL . fromIntegral charE :: Char -> Q Exp charE = litE . charL -- | Returns True if a Type has kind *. hasKindStar :: Type -> Bool hasKindStar VarT{} = True #if MIN_VERSION_template_haskell(2,8,0) hasKindStar (SigT _ StarT) = True #else hasKindStar (SigT _ StarK) = True #endif hasKindStar _ = False -- Returns True is a kind is equal to *, or if it is a kind variable. isStarOrVar :: Kind -> Bool #if MIN_VERSION_template_haskell(2,8,0) isStarOrVar StarT = True isStarOrVar VarT{} = True #else isStarOrVar StarK = True #endif isStarOrVar _ = False -- Generate a list of fresh names with a common prefix, and numbered suffixes. newNameList :: String -> Int -> Q [Name] newNameList prefix n = mapM (newName . (prefix ++) . show) [1..n] -- | Gets all of the type/kind variable names mentioned somewhere in a Type. tyVarNamesOfType :: Type -> [Name] tyVarNamesOfType = go where go :: Type -> [Name] go (AppT t1 t2) = go t1 ++ go t2 go (SigT t _k) = go t #if MIN_VERSION_template_haskell(2,8,0) ++ go _k #endif go (VarT n) = [n] go _ = [] -- | Gets all of the type/kind variable names mentioned somewhere in a Kind. tyVarNamesOfKind :: Kind -> [Name] #if MIN_VERSION_template_haskell(2,8,0) tyVarNamesOfKind = tyVarNamesOfType #else tyVarNamesOfKind _ = [] -- There are no kind variables #endif -- | @hasKindVarChain n kind@ Checks if @kind@ is of the form -- k_0 -> k_1 -> ... -> k_(n-1), where k0, k1, ..., and k_(n-1) can be * or -- kind variables. hasKindVarChain :: Int -> Type -> Maybe [Name] hasKindVarChain kindArrows t = let uk = uncurryKind (tyKind t) in if (length uk - 1 == kindArrows) && all isStarOrVar uk then Just (concatMap tyVarNamesOfKind uk) else Nothing -- | If a Type is a SigT, returns its kind signature. Otherwise, return *. tyKind :: Type -> Kind tyKind (SigT _ k) = k tyKind _ = starK -- | If a VarT is missing an explicit kind signature, steal it from a TyVarBndr. stealKindForType :: TyVarBndr -> Type -> Type stealKindForType tvb t@VarT{} = SigT t (tvbKind tvb) stealKindForType _ t = t -- | Monadic version of concatMap concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b] concatMapM f xs = liftM concat (mapM f xs) -- | A mapping of type variable Names to their show function Names. For example, in a -- TextShow2 declaration, a TyVarMap might look like (a ~> sp1, b ~> sp2), where -- a and b are the last two type variables of the datatype, and sp1 and sp2 are the two -- functions which show their respective type variables. type TyVarMap = Map Name (Name, Name) -- | Checks if a 'Name' represents a tuple type constructor (other than '()') isNonUnitTuple :: Name -> Bool isNonUnitTuple = isTupleString . nameBase -- | Parenthesize an infix constructor name if it is being applied as a prefix -- function (e.g., data Amp a = (:&) a a) parenInfixConName :: Name -> ShowS parenInfixConName conName = let conNameBase = nameBase conName in showParen (isInfixTypeCon conNameBase) $ showString conNameBase -- | Extracts the kind from a TyVarBndr. tvbKind :: TyVarBndr -> Kind tvbKind (PlainTV _) = starK tvbKind (KindedTV _ k) = k -- | Convert a TyVarBndr to a Type. tvbToType :: TyVarBndr -> Type tvbToType (PlainTV n) = VarT n tvbToType (KindedTV n k) = SigT (VarT n) k -- | Applies a typeclass constraint to a type. applyClass :: Name -> Name -> Pred #if MIN_VERSION_template_haskell(2,10,0) applyClass con t = AppT (ConT con) (VarT t) #else applyClass con t = ClassP con [VarT t] #endif -- | Checks to see if the last types in a data family instance can be safely eta- -- reduced (i.e., dropped), given the other types. This checks for three conditions: -- -- (1) All of the dropped types are type variables -- (2) All of the dropped types are distinct -- (3) None of the remaining types mention any of the dropped types canEtaReduce :: [Type] -> [Type] -> Bool canEtaReduce remaining dropped = all isTyVar dropped && allDistinct droppedNames -- Make sure not to pass something of type [Type], since Type -- didn't have an Ord instance until template-haskell-2.10.0.0 && not (any (`mentionsName` droppedNames) remaining) where droppedNames :: [Name] droppedNames = map varTToName dropped -- | Extract Just the Name from a type variable. If the argument Type is not a -- type variable, return Nothing. varTToName_maybe :: Type -> Maybe Name varTToName_maybe (VarT n) = Just n varTToName_maybe (SigT t _) = varTToName_maybe t varTToName_maybe _ = Nothing -- | Extract the Name from a type variable. If the argument Type is not a -- type variable, throw an error. varTToName :: Type -> Name varTToName = fromMaybe (error "Not a type variable!") . varTToName_maybe -- | Peel off a kind signature from a Type (if it has one). unSigT :: Type -> Type unSigT (SigT t _) = t unSigT t = t -- | Is the given type a variable? isTyVar :: Type -> Bool isTyVar (VarT _) = True isTyVar (SigT t _) = isTyVar t isTyVar _ = False -- | Is the given type a type family constructor (and not a data family constructor)? isTyFamily :: Type -> Q Bool isTyFamily (ConT n) = do info <- reify n return $ case info of #if MIN_VERSION_template_haskell(2,11,0) FamilyI OpenTypeFamilyD{} _ -> True #elif MIN_VERSION_template_haskell(2,7,0) FamilyI (FamilyD TypeFam _ _ _) _ -> True #else TyConI (FamilyD TypeFam _ _ _) -> True #endif #if MIN_VERSION_template_haskell(2,9,0) FamilyI ClosedTypeFamilyD{} _ -> True #endif _ -> False isTyFamily _ = return False -- | Are all of the items in a list (which have an ordering) distinct? -- -- This uses Set (as opposed to nub) for better asymptotic time complexity. allDistinct :: Ord a => [a] -> Bool allDistinct = allDistinct' Set.empty where allDistinct' :: Ord a => Set a -> [a] -> Bool allDistinct' uniqs (x:xs) | x `Set.member` uniqs = False | otherwise = allDistinct' (Set.insert x uniqs) xs allDistinct' _ _ = True -- | Does the given type mention any of the Names in the list? mentionsName :: Type -> [Name] -> Bool mentionsName = go where go :: Type -> [Name] -> Bool go (AppT t1 t2) names = go t1 names || go t2 names go (SigT t _k) names = go t names #if MIN_VERSION_template_haskell(2,8,0) || go _k names #endif go (VarT n) names = n `elem` names go _ _ = False -- | Does an instance predicate mention any of the Names in the list? predMentionsName :: Pred -> [Name] -> Bool #if MIN_VERSION_template_haskell(2,10,0) predMentionsName = mentionsName #else predMentionsName (ClassP n tys) names = n `elem` names || any (`mentionsName` names) tys predMentionsName (EqualP t1 t2) names = mentionsName t1 names || mentionsName t2 names #endif -- | Construct a type via curried application. applyTy :: Type -> [Type] -> Type applyTy = foldl' AppT -- | Fully applies a type constructor to its type variables. applyTyCon :: Name -> [Type] -> Type applyTyCon = applyTy . ConT -- | Split an applied type into its individual components. For example, this: -- -- @ -- Either Int Char -- @ -- -- would split to this: -- -- @ -- [Either, Int, Char] -- @ unapplyTy :: Type -> NonEmpty Type unapplyTy = NE.reverse . go where go :: Type -> NonEmpty Type go (AppT t1 t2) = t2 <| go t1 go (SigT t _) = go t go (ForallT _ _ t) = go t go t = t :| [] -- | Split a type signature by the arrows on its spine. For example, this: -- -- @ -- (Int -> String) -> Char -> () -- @ -- -- would split to this: -- -- @ -- [Int -> String, Char, ()] -- @ uncurryTy :: Type -> NonEmpty Type uncurryTy (AppT (AppT ArrowT t1) t2) = t1 <| uncurryTy t2 uncurryTy (SigT t _) = uncurryTy t uncurryTy (ForallT _ _ t) = uncurryTy t uncurryTy t = t :| [] -- | Like uncurryType, except on a kind level. uncurryKind :: Kind -> NonEmpty Kind #if MIN_VERSION_template_haskell(2,8,0) uncurryKind = uncurryTy #else uncurryKind (ArrowK k1 k2) = k1 <| uncurryKind k2 uncurryKind k = k :| [] #endif createKindChain :: Int -> Kind createKindChain = go starK where go :: Kind -> Int -> Kind go k !0 = k #if MIN_VERSION_template_haskell(2,8,0) go k !n = go (AppT (AppT ArrowT StarT) k) (n - 1) #else go k !n = go (ArrowK StarK k) (n - 1) #endif #if MIN_VERSION_template_haskell(2,7,0) -- | Extracts the name of a constructor. constructorName :: Con -> Name constructorName (NormalC name _ ) = name constructorName (RecC name _ ) = name constructorName (InfixC _ name _ ) = name constructorName (ForallC _ _ con) = constructorName con # if MIN_VERSION_template_haskell(2,11,0) constructorName (GadtC names _ _) = head names constructorName (RecGadtC names _ _) = head names # endif #endif isNullaryCon :: Con -> Bool isNullaryCon (NormalC _ []) = True isNullaryCon (RecC _ []) = True isNullaryCon InfixC{} = False isNullaryCon (ForallC _ _ con) = isNullaryCon con #if MIN_VERSION_template_haskell(2,11,0) isNullaryCon (GadtC _ [] _) = True isNullaryCon (RecGadtC _ [] _) = True #endif isNullaryCon _ = False interleave :: [a] -> [a] -> [a] interleave (a1:a1s) (a2:a2s) = a1:a2:interleave a1s a2s interleave _ _ = [] -- Determines the types of a constructor's arguments as well as the last type -- parameters (mapped to their show functions), expanding through any type synonyms. -- The type parameters are determined on a constructor-by-constructor basis since -- they may be refined to be particular types in a GADT. reifyConTys :: TextShowClass -> [(Name, Name)] -> Name -> Q ([Type], TyVarMap) reifyConTys tsClass spls conName = do info <- reify conName uncTy <- case info of DataConI _ ty _ #if !(MIN_VERSION_template_haskell(2,11,0)) _ #endif -> fmap uncurryTy (expandSyn ty) _ -> error "Must be a data constructor" let (argTys, [resTy]) = NE.splitAt (length uncTy - 1) uncTy unapResTy = unapplyTy resTy -- If one of the last type variables is refined to a particular type -- (i.e., not truly polymorphic), we mark it with Nothing and filter -- it out later, since we only apply show functions to arguments of -- a type that it (1) one of the last type variables, and (2) -- of a truly polymorphic type. mbTvNames = map varTToName_maybe $ NE.drop (NE.length unapResTy - fromEnum tsClass) unapResTy -- We use Map.fromList to ensure that if there are any duplicate type -- variables (as can happen in a GADT), the rightmost type variable gets -- associated with the show function. -- -- See Note [Matching functions with GADT type variables] tvMap = Map.fromList . catMaybes -- Drop refined types $ zipWith (\mbTvName sp -> fmap (\tvName -> (tvName, sp)) mbTvName) mbTvNames spls return (argTys, tvMap) {- Note [Matching functions with GADT type variables] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When deriving TextShow2, there is a tricky corner case to consider: data Both a b where BothCon :: x -> x -> Both x x Which show functions should be applied to which arguments of BothCon? We have a choice, since both the function of type (Int -> a -> Builder) and of type (Int -> b -> Builder) can be applied to either argument. In such a scenario, the second show function takes precedence over the first show function, so the derived TextShow2 instance would be: instance TextShow Both where liftShowsPrec2 sp1 sp2 p (BothCon x1 x2) = showbParen (p > appPrec) $ "BothCon " <> sp2 appPrec1 x1 <> showbSpace <> sp2 appPrec1 x2 This is not an arbitrary choice, as this definition ensures that liftShowsPrec2 showsPrec = liftShowsPrec for a derived TextShow1 instance for Both. -} text-show-3.4/src/TextShow/Numeric/0000755000000000000000000000000012756060603015473 5ustar0000000000000000text-show-3.4/src/TextShow/Numeric/Natural.hs0000644000000000000000000000241612756060603017440 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-2016 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(..)) 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-3.4/src/TextShow/Debug/0000755000000000000000000000000012756060603015117 5ustar0000000000000000text-show-3.4/src/TextShow/Debug/Trace.hs0000644000000000000000000002662612756060603016525 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE OverloadedStrings #-} {-| Module: TextShow.Debug.Trace Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Functions for tracing and monitoring execution. These can be useful for investigating bugs or performance problems. They should /not/ be used in production code. If you do not wish to require 'TextShow' instances for your @trace@ functions, the "TextShow.Debug.Trace.TH" and "Text.Show.Text.Debug.Trace.Generic" modules exist to convert the input to a debug message using Template Haskell or generics, respectively. /Since: 2/ -} module TextShow.Debug.Trace ( -- * Tracing -- $tracing tracet , tracetl , tracetId , tracetlId , traceTextShow , traceTextShowId #if MIN_VERSION_base(4,5,0) , tracetStack , tracetlStack #endif , tracetIO , tracetlIO , tracetM , tracetlM , traceTextShowM #if MIN_VERSION_base(4,5,0) -- * Eventlog tracing -- $eventlog_tracing , tracetEvent , tracetlEvent , tracetEventIO , tracetlEventIO #endif #if MIN_VERSION_base(4,7,0) -- * Execution phase markers -- $markers , tracetMarker , tracetlMarker , tracetMarkerIO , tracetlMarkerIO #endif ) where import Control.Monad (unless) import qualified Data.ByteString as BS (null, partition) import Data.ByteString (ByteString, useAsCString) import Data.ByteString.Internal (c2w) import qualified Data.Text as TS (Text) import Data.Text.Encoding (encodeUtf8) import qualified Data.Text.Lazy as TL (Text) import Data.Text.Lazy (toStrict) import Foreign.C.String (CString) #if MIN_VERSION_base(4,5,0) import qualified Data.ByteString.Char8 as BS (pack) import qualified Data.Text as TS (unpack) import qualified Data.Text.Lazy as TL (unpack) import Debug.Trace import GHC.Stack (currentCallStack, renderStack) #endif import Prelude () import Prelude.Compat import System.IO.Unsafe (unsafePerformIO) import TextShow.Classes (TextShow(..)) import TextShow.Instances () -- $tracing -- -- The @tracet(l)@, @traceTextShow@ and @tracet(l)IO@ functions print messages to an -- output stream. They are intended for \"printf debugging\", that is: tracing the flow -- of execution and printing interesting values. -- -- All these functions evaluate the message completely before printing -- it; so if the message is not fully defined, none of it will be -- printed. -- -- The usual output stream is 'System.IO.stderr'. For Windows GUI applications -- (that have no stderr) the output is directed to the Windows debug console. -- Some implementations of these functions may decorate the @Text@ that\'s -- output to indicate that you\'re tracing. -- | The 'tracetIO' function outputs the trace message from the IO monad. -- This sequences the output with respect to other IO actions. -- -- /Since: 2/ tracetIO :: TS.Text -> IO () tracetIO = traceIOByteString . encodeUtf8 -- | Like 'tracetIO' but accepts a lazy 'TL.Text' argument. -- -- /Since: 2/ tracetlIO :: TL.Text -> IO () tracetlIO = tracetIO . toStrict traceIOByteString :: ByteString -> IO () traceIOByteString msg = useAsCString "%s\n" $ \cfmt -> do -- NB: debugBelch can't deal with null bytes, so filter them -- out so we don't accidentally truncate the message. See Trac #9395 let (nulls, msg') = BS.partition (== c2w '\0') msg useAsCString msg' $ \cmsg -> debugBelch cfmt cmsg unless (BS.null nulls) $ useAsCString "WARNING: previous trace message had null bytes" $ \cmsg -> debugBelch cfmt cmsg -- don't use debugBelch() directly, because we cannot call varargs functions -- using the FFI. foreign import ccall unsafe "HsBase.h debugBelch2" debugBelch :: CString -> CString -> IO () {-| The 'tracet' function outputs the trace message given as its first argument, before returning the second argument as its result. For example, this returns the value of @f x@ but first outputs the message. > tracet ("calling f with x = " <> showt x) (f x) The 'tracet' function should /only/ be used for debugging, or for monitoring execution. The function is not referentially transparent: its type indicates that it is a pure function but it has the side effect of outputting the trace message. /Since: 2/ -} tracet :: TS.Text -> a -> a tracet = traceByteString . encodeUtf8 -- | Like 'tracet' but accepts a lazy 'TL.Text' argument. -- -- /Since: 2/ tracetl :: TL.Text -> a -> a tracetl = tracet . toStrict {-# NOINLINE traceByteString #-} traceByteString :: ByteString -> a -> a traceByteString bs expr = unsafePerformIO $ do traceIOByteString bs return expr -- | Like 'tracet' but returns the message instead of a third value. -- -- /Since: 2/ tracetId :: TS.Text -> TS.Text tracetId a = tracet a a -- | Like 'tracetId' but accepts a lazy 'TL.Text' argument. -- -- /Since: 2/ tracetlId :: TL.Text -> TL.Text tracetlId a = tracetl a a {-| Like 'tracet', but uses 'showt' on the argument to convert it to a 'TS.Text'. This makes it convenient for printing the values of interesting variables or expressions inside a function. For example here we print the value of the variables @x@ and @z@: > f x y = > traceTextShow (x, z) $ result > where > z = ... > ... /Since: 2/ -} traceTextShow :: TextShow a => a -> b -> b traceTextShow = tracet . showt -- | Like 'traceTextShow' but returns the shown value instead of a third value. -- -- /Since: 2/ traceTextShowId :: TextShow a => a -> a traceTextShowId a = tracet (showt a) a {-| Like 'tracet' but returning unit in an arbitrary 'Applicative' context. Allows for convenient use in do-notation. Note that the application of 'tracet' is not an action in the 'Applicative' context, as 'tracetIO' is in the 'IO' type. > ... = do > x <- ... > tracetM $ "x: " <> showt x > y <- ... > tracetM $ "y: " <> showt y /Since: 2/ -} tracetM :: Applicative f => TS.Text -> f () tracetM text = tracet text $ pure () -- | Like 'tracetM' but accepts a lazy 'TL.Text' argument. tracetlM :: Applicative f => TL.Text -> f () tracetlM text = tracetl text $ pure () {-| Like 'tracetM', but uses 'showt' on the argument to convert it to a 'TS.Text'. > ... = do > x <- ... > traceTextShowM x > y <- ... > traceTextShowM $ x + y /Since: 2/ -} traceTextShowM :: (TextShow a, Applicative f) => a -> f () traceTextShowM = tracetM . showt #if MIN_VERSION_base(4,5,0) -- | Like 'tracet' but additionally prints a call stack if one is -- available. -- -- In the current GHC implementation, the call stack is only -- availble if the program was compiled with @-prof@; otherwise -- 'tracetStack' behaves exactly like 'tracet'. Entries in the call -- stack correspond to @SCC@ annotations, so it is a good idea to use -- @-fprof-auto@ or @-fprof-auto-calls@ to add SCC annotations automatically. -- -- /Since: 2/ tracetStack :: TS.Text -> a -> a tracetStack = traceStackByteString . encodeUtf8 -- | Like 'tracetStack' but accepts a lazy 'TL.Text' argument. -- -- /Since: 2/ tracetlStack :: TL.Text -> a -> a tracetlStack = tracetStack . toStrict traceStackByteString :: ByteString -> a -> a traceStackByteString bs expr = unsafePerformIO $ do traceIOByteString bs stack <- currentCallStack unless (null stack) . traceIOByteString . BS.pack $ renderStack stack return expr -- $eventlog_tracing -- -- Eventlog tracing is a performance profiling system. These functions emit -- extra events into the eventlog. In combination with eventlog profiling -- tools these functions can be used for monitoring execution and -- investigating performance problems. -- -- Currently only GHC provides eventlog profiling, see the GHC user guide for -- details on how to use it. These function exists for other Haskell -- implementations but no events are emitted. Note that the @Text@ message is -- always evaluated, whether or not profiling is available or enabled. -- | The 'tracetEvent' function behaves like 'tracet' with the difference that -- the message is emitted to the eventlog, if eventlog profiling is available -- and enabled at runtime. -- -- It is suitable for use in pure code. In an IO context use 'tracetEventIO' -- instead. -- -- Note that when using GHC's SMP runtime, it is possible (but rare) to get -- duplicate events emitted if two CPUs simultaneously evaluate the same thunk -- that uses 'traceEvent'. -- -- /Since: 2/ tracetEvent :: TS.Text -> a -> a tracetEvent = traceEvent . TS.unpack -- | Like 'tracetEvent' but accepts a lazy 'TL.Text' argument. -- -- /Since: 2/ tracetlEvent :: TL.Text -> a -> a tracetlEvent = traceEvent . TL.unpack -- | The 'tracetEventIO' function emits a message to the eventlog, if eventlog -- profiling is available and enabled at runtime. -- -- Compared to 'tracetEvent', 'tracetEventIO' sequences the event with respect to -- other IO actions. -- -- /Since: 2/ tracetEventIO :: TS.Text -> IO () tracetEventIO = traceEventIO . TS.unpack -- | Like 'tracetEventIO' but accepts a lazy 'TL.Text' argument. -- -- /Since: 2/ tracetlEventIO :: TL.Text -> IO () tracetlEventIO = traceEventIO . TL.unpack #endif #if MIN_VERSION_base(4,7,0) -- $markers -- -- When looking at a profile for the execution of a program we often want to -- be able to mark certain points or phases in the execution and see that -- visually in the profile. -- For example, a program might have several distinct phases with different -- performance or resource behaviour in each phase. To properly interpret the -- profile graph we really want to see when each phase starts and ends. -- -- Markers let us do this: we can annotate the program to emit a marker at -- an appropriate point during execution and then see that in a profile. -- -- Currently this feature is only supported in GHC by the eventlog tracing -- system, but in future it may also be supported by the heap profiling or -- other profiling tools. These function exists for other Haskell -- implementations but they have no effect. Note that the @Text@ message is -- always evaluated, whether or not profiling is available or enabled. -- | The 'tracetMarker' function emits a marker to the eventlog, if eventlog -- profiling is available and enabled at runtime. The 'TS.Text' is the name of -- the marker. The name is just used in the profiling tools to help you keep -- clear which marker is which. -- -- This function is suitable for use in pure code. In an IO context use -- 'tracetMarkerIO' instead. -- -- Note that when using GHC's SMP runtime, it is possible (but rare) to get -- duplicate events emitted if two CPUs simultaneously evaluate the same thunk -- that uses 'traceMarker'. -- -- /Since: 2/ tracetMarker :: TS.Text -> a -> a tracetMarker msg = traceMarker $ TS.unpack msg -- | Like 'tracetMarker' but accepts a lazy 'TL.Text' argument. -- -- /Since: 2/ tracetlMarker :: TL.Text -> a -> a tracetlMarker msg = traceMarker $ TL.unpack msg -- | The 'tracetMarkerIO' function emits a marker to the eventlog, if eventlog -- profiling is available and enabled at runtime. -- -- Compared to 'tracetMarker', 'tracetMarkerIO' sequences the event with respect to -- other IO actions. -- -- /Since: 2/ tracetMarkerIO :: TS.Text -> IO () tracetMarkerIO = traceMarkerIO . TS.unpack -- | Like 'tracetMarkerIO' but accepts a lazy 'TL.Text' argument. -- -- /Since: 2/ tracetlMarkerIO :: TL.Text -> IO () tracetlMarkerIO = traceMarkerIO . TL.unpack #endif text-show-3.4/src/TextShow/Debug/Trace/0000755000000000000000000000000012756060603016155 5ustar0000000000000000text-show-3.4/src/TextShow/Debug/Trace/TH.hs0000644000000000000000000000263312756060603017030 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-| Module: TextShow.Debug.Trace.TH Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Functions that splice traces into source code which take an arbitrary data type or data family instance as an argument (even if it is not an instance of @TextShow@). You need to enable the @TemplateHaskell@ language extension in order to use this module. /Since: 2/ -} module TextShow.Debug.Trace.TH ( makeTraceTextShow , makeTraceTextShowId , makeTraceTextShowM ) where import Language.Haskell.TH.Syntax (Name, Q, Exp) import TextShow.Debug.Trace import TextShow.TH.Internal (makeShowt) -- | Generates a lambda expression which behaves like 'traceTextShow' (without -- requiring a @TextShow@ instance). -- -- /Since: 2/ makeTraceTextShow :: Name -> Q Exp makeTraceTextShow name = [| tracet . $(makeShowt name) |] -- | Generates a lambda expression which behaves like 'traceTextShowId' (without -- requiring a @TextShow@ instance). -- -- /Since: 2/ makeTraceTextShowId :: Name -> Q Exp makeTraceTextShowId name = [| \a -> tracet ($(makeShowt name) a) a |] -- | Generates a lambda expression which behaves like 'traceTextShowM' (without -- requiring a @TextShow@ instance). -- -- /Since: 2/ makeTraceTextShowM :: Name -> Q Exp makeTraceTextShowM name = [| tracetM . $(makeShowt name) |] text-show-3.4/src/TextShow/Debug/Trace/Generic.hs0000644000000000000000000000234212756060603020066 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-| Module: TextShow.Debug.Trace.Generic Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Functions that trace the values of 'Generic' instances (even if they are not instances of @TextShow@). /Since: 2/ -} module TextShow.Debug.Trace.Generic ( genericTraceTextShow , genericTraceTextShowId , genericTraceTextShowM ) where import Generics.Deriving.Base (Generic, Rep) import Prelude () import Prelude.Compat import TextShow.Debug.Trace import TextShow.Generic (GTextShowT, Zero, genericShowt) -- | A 'Generic' implementation of 'traceTextShow'. -- -- /Since: 2/ genericTraceTextShow :: (Generic a, GTextShowT Zero (Rep a)) => a -> b -> b genericTraceTextShow = tracet . genericShowt -- | A 'Generic' implementation of 'traceTextShowId'. -- -- /Since: 2/ genericTraceTextShowId :: (Generic a, GTextShowT Zero (Rep a)) => a -> a genericTraceTextShowId a = tracet (genericShowt a) a -- | A 'Generic' implementation of 'traceShowM'. -- -- /Since: 2/ genericTraceTextShowM :: (Generic a, GTextShowT Zero (Rep a), Applicative f) => a -> f () genericTraceTextShowM = tracetM . genericShowt text-show-3.4/src/TextShow/Data/0000755000000000000000000000000012756060603014742 5ustar0000000000000000text-show-3.4/src/TextShow/Data/ByteString.hs0000644000000000000000000001332312756060603017372 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-2016 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(..)) 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-3.4/src/TextShow/Data/Integral.hs0000644000000000000000000001626712756060603017057 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Integral Copyright: (C) 2014-2016 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(..)) 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 {-# SPECIALIZE showbIntAtBase :: Int -> (Int -> Char) -> Int -> Builder #-} {-# SPECIALIZE showbIntAtBase :: Int8 -> (Int -> Char) -> Int8 -> Builder #-} {-# SPECIALIZE showbIntAtBase :: Int16 -> (Int -> Char) -> Int16 -> Builder #-} {-# SPECIALIZE showbIntAtBase :: Int32 -> (Int -> Char) -> Int32 -> Builder #-} {-# SPECIALIZE showbIntAtBase :: Int64 -> (Int -> Char) -> Int64 -> Builder #-} {-# SPECIALIZE showbIntAtBase :: Integer -> (Int -> Char) -> Integer -> Builder #-} {-# SPECIALIZE showbIntAtBase :: Word -> (Int -> Char) -> Word -> Builder #-} {-# SPECIALIZE showbIntAtBase :: Word8 -> (Int -> Char) -> Word8 -> Builder #-} {-# SPECIALIZE showbIntAtBase :: Word16 -> (Int -> Char) -> Word16 -> Builder #-} {-# SPECIALIZE showbIntAtBase :: Word32 -> (Int -> Char) -> Word32 -> Builder #-} {-# SPECIALIZE showbIntAtBase :: Word64 -> (Int -> Char) -> Word64 -> Builder #-} showbIntAtBase base toChr n0 | base <= 1 = error . toString $ "TextShow.Int.showbIntAtBase: applied to unsupported base" <> showb base | n0 < 0 = error . toString $ "TextShow.Int.showbIntAtBase: applied to negative number " <> showb n0 | otherwise = showbIt (quotRem n0 base) mempty where showbIt (n, d) b = seq c $ -- stricter than necessary case n of 0 -> b' _ -> showbIt (quotRem n base) b' where c :: Char c = toChr $ fromIntegral d b' :: Builder b' = singleton c <> b -- | Show /non-negative/ 'Integral' numbers in base 2. -- -- /Since: 2/ showbBin :: (Integral a, TextShow a) => a -> Builder showbBin = showbIntAtBase 2 intToDigit {-# INLINE showbBin #-} -- | Show /non-negative/ 'Integral' numbers in base 16. -- -- /Since: 2/ showbHex :: (Integral a, TextShow a) => a -> Builder showbHex = showbIntAtBase 16 intToDigit {-# INLINE showbHex #-} -- | Show /non-negative/ 'Integral' numbers in base 8. -- -- /Since: 2/ showbOct :: (Integral a, TextShow a) => a -> Builder showbOct = showbIntAtBase 8 intToDigit {-# INLINE showbOct #-} -- | 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-3.4/src/TextShow/Data/Proxy.hs0000644000000000000000000000225712756060603016425 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-2016 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(..)) import TextShow.TH.Internal (deriveTextShow1, makeShowbPrec, makeShowtPrec, makeShowtlPrec) #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) showtPrec = $(makeShowtPrec ''Proxy) showtlPrec = $(makeShowtlPrec ''Proxy) INLINE_INST_FUN(showbPrec) INLINE_INST_FUN(showtPrec) INLINE_INST_FUN(showtlPrec) $(deriveTextShow1 ''Proxy) text-show-3.4/src/TextShow/Data/List.hs0000644000000000000000000000162012756060603016210 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.List Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Exports 'showbListWith', 'showtListWith', and 'showtlListWith'. -} module TextShow.Data.List (showbListWith, showtListWith, showtlListWith) where import TextShow.Classes (TextShow(..), TextShow1(..), showbListWith, showtListWith, showtlListWith) 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 liftShowbPrec _ sl _ = sl INLINE_INST_FUN(liftShowbPrec) text-show-3.4/src/TextShow/Data/Dynamic.hs0000644000000000000000000000165312756060603016667 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Dynamic Copyright: (C) 2014-2016 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(..)) 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-3.4/src/TextShow/Data/Fixed.hs0000644000000000000000000000524712756060603016345 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Fixed Copyright: (C) 2014-2016 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(..)) #if MIN_VERSION_base(4,7,0) import Data.Fixed (Fixed(..)) import Data.Int (Int64) import Data.Monoid.Compat ((<>)) import Data.Semigroup (mtimesDefault) import Data.Text.Lazy.Builder (singleton) import TextShow.Data.Integral () import TextShow.Utils (lengthB) #else import Data.Fixed (Fixed, showFixed) import Data.Text.Lazy.Builder (fromString) #endif #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-3.4/src/TextShow/Data/Either.hs0000644000000000000000000000201012756060603016507 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Either Copyright: (C) 2014-2016 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 (liftShowbEitherPrec2) where import Data.Text.Lazy.Builder (Builder) import TextShow.Classes (liftShowbPrec2) 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: 3/ liftShowbEitherPrec2 :: (Int -> a -> Builder) -> (Int -> b -> Builder) -> Int -> Either a b -> Builder liftShowbEitherPrec2 sp1 sp2 = liftShowbPrec2 sp1 undefined sp2 undefined {-# INLINE liftShowbEitherPrec2 #-} $(deriveTextShow ''Either) $(deriveTextShow1 ''Either) $(deriveTextShow2 ''Either) text-show-3.4/src/TextShow/Data/Void.hs0000644000000000000000000000127312756060603016202 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Void Copyright: (C) 2014-2016 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(..)) -- | 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-3.4/src/TextShow/Data/Bool.hs0000644000000000000000000000120112756060603016163 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Bool Copyright: (C) 2014-2016 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-3.4/src/TextShow/Data/Maybe.hs0000644000000000000000000000160212756060603016332 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Maybe Copyright: (C) 2014-2016 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 (liftShowbMaybePrec) where import Data.Text.Lazy.Builder (Builder) import TextShow.Classes (liftShowbPrec) import TextShow.TH.Internal (deriveTextShow, deriveTextShow1) #include "inline.h" -- | Convert a 'Maybe' value to a 'Builder' with the given show function and precedence. -- -- /Since: 3/ liftShowbMaybePrec :: (Int -> a -> Builder) -> Int -> Maybe a -> Builder liftShowbMaybePrec sp = liftShowbPrec sp undefined {-# INLINE liftShowbMaybePrec #-} $(deriveTextShow ''Maybe) $(deriveTextShow1 ''Maybe) text-show-3.4/src/TextShow/Data/Data.hs0000644000000000000000000000357012756060603016154 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Data Copyright: (C) 2014-2016 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(..)) 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-3.4/src/TextShow/Data/Complex.hs0000644000000000000000000000324112756060603016705 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Ratio Copyright: (C) 2014-2016 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(..)) 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-3.4/src/TextShow/Data/Ratio.hs0000644000000000000000000000341412756060603016356 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Ratio Copyright: (C) 2014-2016 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(..), 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 liftShowbPrec sp _ p (numer :% denom) = showbParen (p > ratioPrec) $ sp ratioPrec1 numer <> " % " <> sp ratioPrec1 denom INLINE_INST_FUN(liftShowbPrec) #endif text-show-3.4/src/TextShow/Data/Text.hs0000644000000000000000000001070012756060603016220 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-2016 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(..)) 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-3.4/src/TextShow/Data/OldTypeable.hs0000644000000000000000000000462012756060603017504 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-2016 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(..), 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-3.4/src/TextShow/Data/Floating.hs0000644000000000000000000003307312756060603017047 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Floating Copyright: (C) 2014-2016 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(..), 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-3.4/src/TextShow/Data/Semigroup.hs0000644000000000000000000000625612756060603017261 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Semigroup Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' functions for data types in the "Data.Semigroup" module. /Since: 3/ -} module TextShow.Data.Semigroup ( liftShowbMinPrec , liftShowbMaxPrec , liftShowbFirstPrec , liftShowbLastPrec , liftShowbWrappedMonoidPrec , liftShowbOptionPrec , liftShowbArgPrec2 ) where import Data.Semigroup (Min, Max, First, Last, WrappedMonoid, Option, Arg) import Data.Text.Lazy.Builder (Builder) import TextShow.Classes (TextShow1(..), TextShow2(..)) import TextShow.Data.Maybe () import TextShow.TH.Internal (deriveTextShow, deriveTextShow1, deriveTextShow2) -- | Convert a 'Min' value to a 'Builder' with the given show function and precedence. -- -- /Since: 3/ liftShowbMinPrec :: (Int -> a -> Builder) -> Int -> Min a -> Builder liftShowbMinPrec sp = liftShowbPrec sp undefined {-# INLINE liftShowbMinPrec #-} -- | Convert a 'Max' value to a 'Builder' with the given show function and precedence. -- -- /Since: 3/ liftShowbMaxPrec :: (Int -> a -> Builder) -> Int -> Max a -> Builder liftShowbMaxPrec sp = liftShowbPrec sp undefined {-# INLINE liftShowbMaxPrec #-} -- | Convert a 'First' value to a 'Builder' with the given show function and precedence. -- -- /Since: 3/ liftShowbFirstPrec :: (Int -> a -> Builder) -> Int -> First a -> Builder liftShowbFirstPrec sp = liftShowbPrec sp undefined {-# INLINE liftShowbFirstPrec #-} -- | Convert a 'Last' value to a 'Builder' with the given show function and precedence. -- -- /Since: 3/ liftShowbLastPrec :: (Int -> a -> Builder) -> Int -> Last a -> Builder liftShowbLastPrec sp = liftShowbPrec sp undefined {-# INLINE liftShowbLastPrec #-} -- | Convert a 'WrappedMonoid' to a 'Builder' with the given show function -- and precedence. -- -- /Since: 3/ liftShowbWrappedMonoidPrec :: (Int -> m -> Builder) -> Int -> WrappedMonoid m -> Builder liftShowbWrappedMonoidPrec sp = liftShowbPrec sp undefined {-# INLINE liftShowbWrappedMonoidPrec #-} -- | Convert an 'Option' value to a 'Builder' with the given show function -- and precedence. -- -- /Since: 3/ liftShowbOptionPrec :: (Int -> a -> Builder) -> Int -> Option a -> Builder liftShowbOptionPrec sp = liftShowbPrec sp undefined {-# INLINE liftShowbOptionPrec #-} -- | Convert an 'Arg' value to a 'Builder' with the given show functions and precedence. -- -- /Since: 3/ liftShowbArgPrec2 :: (Int -> a -> Builder) -> (Int -> b -> Builder) -> Int -> Arg a b -> Builder liftShowbArgPrec2 sp1 sp2 = liftShowbPrec2 sp1 undefined sp2 undefined {-# INLINE liftShowbArgPrec2 #-} $(deriveTextShow ''Min) $(deriveTextShow1 ''Min) $(deriveTextShow ''Max) $(deriveTextShow1 ''Max) $(deriveTextShow ''First) $(deriveTextShow1 ''First) $(deriveTextShow ''Last) $(deriveTextShow1 ''Last) $(deriveTextShow ''WrappedMonoid) $(deriveTextShow1 ''WrappedMonoid) $(deriveTextShow ''Option) $(deriveTextShow1 ''Option) $(deriveTextShow ''Arg) $(deriveTextShow1 ''Arg) $(deriveTextShow2 ''Arg) text-show-3.4/src/TextShow/Data/Tuple.hs0000644000000000000000000001721612756060603016376 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Tuple Copyright: (C) 2014-2016 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 , liftShowb2Tuple2 , liftShowb3Tuple2 , liftShowb4Tuple2 , liftShowb5Tuple2 , liftShowb6Tuple2 , liftShowb7Tuple2 , liftShowb8Tuple2 , liftShowb9Tuple2 , liftShowb10Tuple2 , liftShowb11Tuple2 , liftShowb12Tuple2 , liftShowb13Tuple2 , liftShowb14Tuple2 , liftShowb15Tuple2 ) where import Data.Text.Lazy.Builder (Builder) import TextShow.Classes (TextShow(..), TextShow2(..)) import TextShow.TH.Internal (deriveTextShow, deriveTextShow1, deriveTextShow2) #include "inline.h" -- | Converts @()@ into a 'Builder'. -- -- /Since: 2/ showbUnit :: () -> Builder showbUnit = showb -- | Converts a 2-tuple into a 'Builder' with the given show functions. -- -- /Since: 3/ liftShowb2Tuple2 :: (a -> Builder) -> (b -> Builder) -> (a, b) -> Builder liftShowb2Tuple2 = liftShowb2 {-# INLINE liftShowb2Tuple2 #-} -- | Converts a 3-tuple into a 'Builder' with the given show functions. -- -- /Since: 3/ liftShowb3Tuple2 :: TextShow a => (b -> Builder) -> (c -> Builder) -> (a, b, c) -> Builder liftShowb3Tuple2 = liftShowb2 {-# INLINE liftShowb3Tuple2 #-} -- | Converts a 4-tuple into a 'Builder' with the given show functions. -- -- /Since: 3/ liftShowb4Tuple2 :: (TextShow a, TextShow b) => (c -> Builder) -> (d -> Builder) -> (a, b, c, d) -> Builder liftShowb4Tuple2 = liftShowb2 {-# INLINE liftShowb4Tuple2 #-} -- | Converts a 5-tuple into a 'Builder' with the given show functions. -- -- /Since: 3/ liftShowb5Tuple2 :: (TextShow a, TextShow b, TextShow c) => (d -> Builder) -> (e -> Builder) -> (a, b, c, d, e) -> Builder liftShowb5Tuple2 = liftShowb2 {-# INLINE liftShowb5Tuple2 #-} -- | Converts a 6-tuple into a 'Builder' with the given show functions. -- -- /Since: 3/ liftShowb6Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d) => (e -> Builder) -> (f -> Builder) -> (a, b, c, d, e, f) -> Builder liftShowb6Tuple2 = liftShowb2 {-# INLINE liftShowb6Tuple2 #-} -- | Converts a 7-tuple into a 'Builder' with the given show functions. -- -- /Since: 3/ liftShowb7Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e) => (f -> Builder) -> (g -> Builder) -> (a, b, c, d, e, f, g) -> Builder liftShowb7Tuple2 = liftShowb2 {-# INLINE liftShowb7Tuple2 #-} -- | Converts an 8-tuple into a 'Builder' with the given show functions. -- -- /Since: 3/ liftShowb8Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f) => (g -> Builder) -> (h -> Builder) -> (a, b, c, d, e, f, g, h) -> Builder liftShowb8Tuple2 = liftShowb2 {-# INLINE liftShowb8Tuple2 #-} -- | Converts a 9-tuple into a 'Builder' with the given show functions. -- -- /Since: 3/ liftShowb9Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f, TextShow g) => (h -> Builder) -> (i -> Builder) -> (a, b, c, d, e, f, g, h, i) -> Builder liftShowb9Tuple2 = liftShowb2 {-# INLINE liftShowb9Tuple2 #-} -- | Converts a 10-tuple into a 'Builder' with the given show functions. -- -- /Since: 3/ liftShowb10Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f, TextShow g, TextShow h) => (i -> Builder) -> (j -> Builder) -> (a, b, c, d, e, f, g, h, i, j) -> Builder liftShowb10Tuple2 = liftShowb2 {-# INLINE liftShowb10Tuple2 #-} -- | Converts an 11-tuple into a 'Builder' with the given show functions. -- -- /Since: 3/ liftShowb11Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f, TextShow g, TextShow h, TextShow i) => (j -> Builder) -> (k -> Builder) -> (a, b, c, d, e, f, g, h, i, j, k) -> Builder liftShowb11Tuple2 = liftShowb2 {-# INLINE liftShowb11Tuple2 #-} -- | Converts a 12-tuple into a 'Builder' with the given show functions. -- -- /Since: 3/ liftShowb12Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f, TextShow g, TextShow h, TextShow i, TextShow j) => (k -> Builder) -> (l -> Builder) -> (a, b, c, d, e, f, g, h, i, j, k, l) -> Builder liftShowb12Tuple2 = liftShowb2 {-# INLINE liftShowb12Tuple2 #-} -- | Converts a 13-tuple into a 'Builder' with the given show functions. -- -- /Since: 3/ liftShowb13Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f, TextShow g, TextShow h, TextShow i, TextShow j, TextShow k) => (l -> Builder) -> (m -> Builder) -> (a, b, c, d, e, f, g, h, i, j, k, l, m) -> Builder liftShowb13Tuple2 = liftShowb2 {-# INLINE liftShowb13Tuple2 #-} -- | Converts a 14-tuple into a 'Builder' with the given show functions. -- -- /Since: 3/ liftShowb14Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f, TextShow g, TextShow h, TextShow i, TextShow j, TextShow k, TextShow l) => (m -> Builder) -> (n -> Builder) -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -> Builder liftShowb14Tuple2 = liftShowb2 {-# INLINE liftShowb14Tuple2 #-} -- | Converts a 15-tuple into a 'Builder' with the given show functions. -- -- /Since: 3/ liftShowb15Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f, TextShow g, TextShow h, TextShow i, TextShow j, TextShow k, TextShow l, TextShow m) => (n -> Builder) -> (o -> Builder) -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -> Builder liftShowb15Tuple2 = liftShowb2 {-# INLINE liftShowb15Tuple2 #-} -- | Like 'liftShowbPrec2', except precedence-agnostic. liftShowb2 :: TextShow2 f => (a -> Builder) -> (b -> Builder) -> f a b -> Builder liftShowb2 sp1 sp2 = liftShowbPrec2 (const sp1) undefined (const sp2) undefined 0 -- The Great Pyramids of Template Haskell $(deriveTextShow ''()) $(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-3.4/src/TextShow/Data/Monoid.hs0000644000000000000000000000754212756060603016533 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-2016 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 , liftShowbDualPrec , liftShowbFirstPrec , liftShowbLastPrec , liftShowbProductPrec , liftShowbSumPrec #if MIN_VERSION_base(4,8,0) , showbAltPrec , liftShowbAltPrec #endif ) where import Data.Monoid.Compat (All, Any, Dual, First, Last, Product, Sum) import Data.Text.Lazy.Builder (Builder) import TextShow.Classes (TextShow(..), TextShow1(..)) import TextShow.Data.Bool () import TextShow.Data.Maybe () import TextShow.TH.Internal (deriveTextShow, deriveTextShow1) #if MIN_VERSION_base(4,8,0) import Data.Monoid (Alt) import TextShow.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: 3/ liftShowbDualPrec :: (Int -> a -> Builder) -> Int -> Dual a -> Builder liftShowbDualPrec sp = liftShowbPrec sp undefined {-# INLINE liftShowbDualPrec #-} -- | Convert a 'First' value to a 'Builder' with the given show function and precedence. -- -- /Since: 3/ liftShowbFirstPrec :: (Int -> a -> Builder) -> Int -> First a -> Builder liftShowbFirstPrec sp = liftShowbPrec sp undefined {-# INLINE liftShowbFirstPrec #-} -- | Convert a 'Last' value to a 'Builder' with the given show function and precedence. -- -- /Since: 3/ liftShowbLastPrec :: (Int -> a -> Builder) -> Int -> Last a -> Builder liftShowbLastPrec sp = liftShowbPrec sp undefined {-# INLINE liftShowbLastPrec #-} -- | Convert a 'Product' value to a 'Builder' with the given show function -- and precedence. -- -- /Since: 3/ liftShowbProductPrec :: (Int -> a -> Builder) -> Int -> Product a -> Builder liftShowbProductPrec sp = liftShowbPrec sp undefined {-# INLINE liftShowbProductPrec #-} -- | Convert a 'Sum' value to a 'Builder' with the given show function and precedence. -- -- /Since: 3/ liftShowbSumPrec :: (Int -> a -> Builder) -> Int -> Sum a -> Builder liftShowbSumPrec sp = liftShowbPrec sp undefined {-# INLINE liftShowbSumPrec #-} #if MIN_VERSION_base(4,8,0) -- | Convert an 'Alt' value to a 'Builder' with the given precedence. -- 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: 3/ liftShowbAltPrec :: TextShow1 f => (Int -> a -> Builder) -> ([a] -> Builder) -> Int -> Alt f a -> Builder liftShowbAltPrec = liftShowbPrec {-# INLINE liftShowbAltPrec #-} #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-3.4/src/TextShow/Data/Typeable.hs0000644000000000000000000001344712756060603017054 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE OverloadedStrings #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Typeable Copyright: (C) 2014-2016 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 #if MIN_VERSION_base(4,9,0) , showbTrName , showbModule #endif ) where import Data.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (Builder, fromString, singleton) import Data.Typeable (TypeRep, typeRepArgs, typeRepTyCon) #if MIN_VERSION_base(4,4,0) import Data.Typeable.Internal (tyConName) # if MIN_VERSION_base(4,8,0) import Data.Typeable.Internal (typeRepKinds) # endif # if MIN_VERSION_base(4,9,0) import Data.Typeable.Internal (Proxy(..), Typeable, TypeRep(TypeRep), typeRep) import GHC.Exts (RuntimeRep(..), TYPE) # elif MIN_VERSION_base(4,4,0) import Data.Typeable.Internal (funTc, listTc) # endif #else import Data.Typeable (mkTyCon, tyConString, typeOf) #endif #if MIN_VERSION_base(4,9,0) import GHC.Exts (Char(..)) import GHC.Prim (Addr#, (+#), eqChar#, indexCharOffAddr#) import GHC.Types (TyCon(..), TrName(..), Module(..), isTrue#) #elif MIN_VERSION_base(4,4,0) import Data.Typeable.Internal (TyCon) #else import Data.Typeable (TyCon) #endif import TextShow.Classes (TextShow(..), showbParen, showbSpace) import TextShow.Data.List () import TextShow.Data.Typeable.Utils (showbArgs, showbTuple) import TextShow.Utils (isTupleString) #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 #if MIN_VERSION_base(4,9,0) [x@(TypeRep _ argCon _ _)] #else [x] #endif | tycon == tcList -> singleton '[' <> showb x <> singleton ']' #if MIN_VERSION_base(4,9,0) | tycon == tcTYPE && argCon == tc'Lifted -> singleton '*' | tycon == tcTYPE && argCon == tc'Unlifted -> singleton '#' #endif [a,r] | tycon == tcFun -> showbParen (p > 8) $ showbPrec 9 a <> " -> " <> showbPrec 8 r xs | isTupleTyCon tycon -> showbTuple xs | otherwise -> showbParen (p > 9) $ showbPrec p tycon <> showbSpace <> showbArgs showbSpace #if MIN_VERSION_base(4,8,0) (kinds ++ tys) #else tys #endif where tycon = typeRepTyCon tyrep tys = typeRepArgs tyrep #if MIN_VERSION_base(4,8,0) kinds = typeRepKinds tyrep #endif #if MIN_VERSION_base(4,9,0) tyConOf :: Typeable a => Proxy a -> TyCon tyConOf = typeRepTyCon . typeRep tcFun :: TyCon tcFun = tyConOf (Proxy :: Proxy (Int -> Int)) tcList :: TyCon tcList = tyConOf (Proxy :: Proxy []) tcTYPE :: TyCon tcTYPE = tyConOf (Proxy :: Proxy TYPE) tc'Lifted :: TyCon tc'Lifted = tyConOf (Proxy :: Proxy 'PtrRepLifted) tc'Unlifted :: TyCon tc'Unlifted = tyConOf (Proxy :: Proxy 'PtrRepUnlifted) #elif MIN_VERSION_base(4,4,0) -- | The list 'TyCon'. tcList :: TyCon tcList = listTc -- | The function (@->@) 'TyCon'. tcFun :: TyCon tcFun = funTc #else -- | The list 'TyCon'. tcList :: TyCon tcList = typeRepTyCon $ typeOf [()] -- | The function (@->@) 'TyCon'. tcFun :: TyCon tcFun = mkTyCon "->" #endif -- | 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 #if MIN_VERSION_base(4,9,0) showbTyCon (TyCon _ _ _ tc_name) = showb tc_name #else showbTyCon = fromString . tyConString #endif {-# INLINE showbTyCon #-} #if MIN_VERSION_base(4,9,0) -- | Convert a 'TrName' to a 'Builder'. -- This function is only available with @base-4.9.0.0@ or later. -- -- /Since: 3/ showbTrName :: TrName -> Builder showbTrName (TrNameS s) = unpackCStringToBuilder# s showbTrName (TrNameD s) = fromString s -- | Convert a 'Module' to a 'Builder'. -- This function is only available with @base-4.9.0.0@ or later. -- -- /Since: 3/ showbModule :: Module -> Builder showbModule (Module p m) = showb p <> singleton ':' <> showb m {-# INLINE showbModule #-} unpackCStringToBuilder# :: Addr# -> Builder -- There's really no point in inlining this, ever, as the loop doesn't -- specialise in an interesting But it's pretty small, so there's a danger -- that it'll be inlined at every literal, which is a waste unpackCStringToBuilder# addr = unpack 0# where unpack nh | isTrue# (ch `eqChar#` '\0'#) = mempty | True = singleton (C# ch) <> unpack (nh +# 1#) where !ch = indexCharOffAddr# addr nh {-# NOINLINE unpackCStringToBuilder# #-} #endif #if MIN_VERSION_base(4,4,0) -- | Identical to 'tyConName'. Defined to avoid using excessive amounts of pragmas -- with base-4.3 and earlier, which use 'tyConString'. 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) #if MIN_VERSION_base(4,9,0) instance TextShow TrName where showb = showbTrName INLINE_INST_FUN(showb) instance TextShow Module where showb = showbModule INLINE_INST_FUN(showb) #endif text-show-3.4/src/TextShow/Data/Array.hs0000644000000000000000000000467012756060603016363 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Array Copyright: (C) 2014-2016 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(..), 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-3.4/src/TextShow/Data/Version.hs0000644000000000000000000000272112756060603016725 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Version Copyright: (C) 2014-2016 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-3.4/src/TextShow/Data/Char.hs0000644000000000000000000000670212756060603016160 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Char Copyright: (C) 2014-2016 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-3.4/src/TextShow/Data/Ord.hs0000644000000000000000000000207112756060603016022 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Ord Copyright: (C) 2014-2016 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 , liftShowbDownPrec ) where import Data.Text.Lazy.Builder (Builder) import GHC.Exts (Down) import TextShow.Classes (showb, liftShowbPrec) 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: 3/ liftShowbDownPrec :: (Int -> a -> Builder) -> Int -> Down a -> Builder liftShowbDownPrec sp = liftShowbPrec sp undefined {-# INLINE liftShowbDownPrec #-} $(deriveTextShow ''Ordering) $(deriveTextShow ''Down) $(deriveTextShow1 ''Down) text-show-3.4/src/TextShow/Data/Functor/0000755000000000000000000000000012756060603016362 5ustar0000000000000000text-show-3.4/src/TextShow/Data/Functor/Product.hs0000644000000000000000000000226112756060603020337 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Functor.Product Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' function for 'Product'. /Since: 3/ -} module TextShow.Data.Functor.Product (liftShowbProductPrec) where import Data.Functor.Product (Product(..)) import Data.Text.Lazy.Builder (Builder) import TextShow.Classes (TextShow(..), TextShow1(..), showbPrec1) import TextShow.TH.Internal (deriveTextShow1) #include "inline.h" -- | Convert a 'Product' value to a 'Builder' with the given show functions -- and precedence. -- -- /Since: 3/ liftShowbProductPrec :: (TextShow1 f, TextShow1 g) => (Int -> a -> Builder) -> ([a] -> Builder) -> Int -> Product f g a -> Builder liftShowbProductPrec = liftShowbPrec {-# INLINE liftShowbProductPrec #-} instance (TextShow1 f, TextShow1 g, TextShow a) => TextShow (Product f g a) where showbPrec = showbPrec1 INLINE_INST_FUN(showbPrec) $(deriveTextShow1 ''Product) text-show-3.4/src/TextShow/Data/Functor/Identity.hs0000644000000000000000000000242612756060603020513 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Functor.Identity Copyright: (C) 2014-2016 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 (liftShowbIdentityPrec) where import Data.Functor.Identity (Identity(..)) import Data.Text.Lazy.Builder (Builder) import TextShow.Classes (TextShow(..), TextShow1(..), showbPrec1, showbUnaryWith) #include "inline.h" -- | Convert an 'Identity' value to a 'Builder' with the given show function -- and precedence. -- -- /Since: 3/ liftShowbIdentityPrec :: (Int -> a -> Builder) -> Int -> Identity a -> Builder -- This would be equivalent to the derived instance of 'Identity' if the -- 'runIdentity' field were removed. liftShowbIdentityPrec sp p (Identity x) = showbUnaryWith sp "Identity" p x {-# INLINE liftShowbIdentityPrec #-} instance TextShow a => TextShow (Identity a) where showbPrec = showbPrec1 {-# INLINE showbPrec #-} instance TextShow1 Identity where liftShowbPrec sp _ = liftShowbIdentityPrec sp INLINE_INST_FUN(liftShowbPrec) text-show-3.4/src/TextShow/Data/Functor/Compose.hs0000644000000000000000000000253212756060603020325 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Functor.Compose Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' function for 'Compose'. /Since: 3/ -} module TextShow.Data.Functor.Compose (liftShowbComposePrec) where import Data.Functor.Compose (Compose(..)) import Data.Text.Lazy.Builder (Builder) import TextShow.Classes (TextShow(..), TextShow1(..), showbPrec1, showbUnaryWith) #include "inline.h" -- | Convert a 'Compose' value to a 'Builder' with the given show functions -- and precedence. -- -- /Since: 3/ liftShowbComposePrec :: (TextShow1 f, TextShow1 g) => (Int -> a -> Builder) -> ([a] -> Builder) -> Int -> Compose f g a -> Builder liftShowbComposePrec sp sl p (Compose x) = showbUnaryWith (liftShowbPrec (liftShowbPrec sp sl) (liftShowbList sp sl)) "Compose" p x instance (TextShow1 f, TextShow1 g, TextShow a) => TextShow (Compose f g a) where showbPrec = showbPrec1 INLINE_INST_FUN(showbPrec) instance (TextShow1 f, TextShow1 g) => TextShow1 (Compose f g) where liftShowbPrec = liftShowbComposePrec INLINE_INST_FUN(liftShowbPrec) text-show-3.4/src/TextShow/Data/Functor/Sum.hs0000644000000000000000000000216512756060603017466 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Functor.Sum Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' function for 'Sum'. /Since: 3/ -} module TextShow.Data.Functor.Sum (liftShowbSumPrec) where import Data.Functor.Sum (Sum(..)) import Data.Text.Lazy.Builder (Builder) import TextShow.Classes (TextShow(..), TextShow1(..), showbPrec1) import TextShow.TH.Internal (deriveTextShow1) #include "inline.h" -- | Convert a 'Sum' value to a 'Builder' with the given show functions -- and precedence. -- -- /Since: 3/ liftShowbSumPrec :: (TextShow1 f, TextShow1 g) => (Int -> a -> Builder) -> ([a] -> Builder) -> Int -> Sum f g a -> Builder liftShowbSumPrec = liftShowbPrec {-# INLINE liftShowbSumPrec #-} instance (TextShow1 f, TextShow1 g, TextShow a) => TextShow (Sum f g a) where showbPrec = showbPrec1 INLINE_INST_FUN(showbPrec) $(deriveTextShow1 ''Sum) text-show-3.4/src/TextShow/Data/Type/0000755000000000000000000000000012756060603015663 5ustar0000000000000000text-show-3.4/src/TextShow/Data/Type/Coercion.hs0000644000000000000000000000240212756060603017756 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-2016 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(..), TextShow1(..)) import TextShow.TH.Internal (deriveTextShow, deriveTextShow2, makeLiftShowbPrec) -- | Convert a representational equality value to a 'Builder'. -- This function is only available with @base-4.7.0.0@ or later. -- -- /Since: 2/ showbCoercion :: Coercion a b -> Builder showbCoercion = showb {-# INLINE showbCoercion #-} $(deriveTextShow ''Coercion) instance TextShow1 (Coercion a) where liftShowbPrec = $(makeLiftShowbPrec ''Coercion) $(deriveTextShow2 ''Coercion) #endif text-show-3.4/src/TextShow/Data/Type/Equality.hs0000644000000000000000000000243312756060603020016 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-2016 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(..), TextShow1(..)) import TextShow.TH.Internal (deriveTextShow, deriveTextShow2, makeLiftShowbPrec) -- | Convert a propositional equality value to a 'Builder'. -- This function is only available with @base-4.7.0.0@ or later. -- -- /Since: 2/ showbPropEquality :: (a :~: b) -> Builder showbPropEquality = showb {-# INLINE showbPropEquality #-} $(deriveTextShow ''(:~:)) instance TextShow1 ((:~:) a) where liftShowbPrec = $(makeLiftShowbPrec ''(:~:)) $(deriveTextShow2 ''(:~:)) #endif text-show-3.4/src/TextShow/Data/Typeable/0000755000000000000000000000000012756060603016507 5ustar0000000000000000text-show-3.4/src/TextShow/Data/Typeable/Utils.hs0000644000000000000000000000200212756060603020135 0ustar0000000000000000{-| Module: TextShow.Data.Typeable.Utils Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Utility functions for showing data types in the @Typeable@ (or @OldTypeable@) module. -} module TextShow.Data.Typeable.Utils (showbArgs, showbTuple) where import Data.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (Builder, singleton) import Prelude () import Prelude.Compat import TextShow.Classes (TextShow(..)) -- | Helper function for showing a list of arguments, each separated by the given -- 'Builder'. showbArgs :: TextShow a => Builder -> [a] -> Builder showbArgs _ [] = mempty showbArgs _ [a] = showbPrec 10 a showbArgs sep (a:as) = showbPrec 10 a <> sep <> showbArgs sep as -- | Helper function for showing a list of 'Show' instances in a tuple. showbTuple :: TextShow a => [a] -> Builder showbTuple args = singleton '(' <> showbArgs (singleton ',') args <> singleton ')' {-# INLINE showbTuple #-} text-show-3.4/src/TextShow/Data/List/0000755000000000000000000000000012756060603015655 5ustar0000000000000000text-show-3.4/src/TextShow/Data/List/NonEmpty.hs0000644000000000000000000000166612756060603017773 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.List.NonEmpty Copyright: (C) 2014-2016 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC Monomorphic 'TextShow' function for 'NonEmpty' lists. /Since: 3/ -} module TextShow.Data.List.NonEmpty (liftShowbNonEmptyPrec) where import Data.List.NonEmpty (NonEmpty(..)) import Data.Text.Lazy.Builder (Builder) import TextShow.Classes (TextShow1(..)) import TextShow.Data.List () import TextShow.TH.Internal (deriveTextShow, deriveTextShow1) -- | Convert a 'NonEmpty' value to a 'Builder' with the given show functions -- and precedence. -- -- /Since: 3/ liftShowbNonEmptyPrec :: (Int -> a -> Builder) -> ([a] -> Builder) -> Int -> NonEmpty a -> Builder liftShowbNonEmptyPrec = liftShowbPrec $(deriveTextShow ''NonEmpty) $(deriveTextShow1 ''NonEmpty)