text-show 3.9 → 3.11.4
raw patch · 182 files changed
Files
- CHANGELOG.md +156/−0
- README.md +16/−5
- benchmarks/Bench.hs +3/−3
- include/generic.h +0/−11
- include/overlap.h +0/−16
- shared/TextShow/TH/Names.hs +19/−51
- src/TextShow/Classes.hs +25/−22
- src/TextShow/Control/Applicative.hs +2/−5
- src/TextShow/Control/Concurrent.hs +1/−1
- src/TextShow/Control/Exception.hs +8/−22
- src/TextShow/Control/Monad/ST.hs +1/−1
- src/TextShow/Data/Array.hs +1/−5
- src/TextShow/Data/Array/Byte.hs +61/−0
- src/TextShow/Data/Bool.hs +1/−1
- src/TextShow/Data/ByteString.hs +1/−34
- src/TextShow/Data/Char.hs +1/−1
- src/TextShow/Data/Complex.hs +25/−1
- src/TextShow/Data/Data.hs +1/−1
- src/TextShow/Data/Dynamic.hs +1/−1
- src/TextShow/Data/Either.hs +1/−1
- src/TextShow/Data/Fixed.hs +5/−25
- src/TextShow/Data/Floating.hs +16/−30
- src/TextShow/Data/Functor/Compose.hs +1/−1
- src/TextShow/Data/Functor/Identity.hs +1/−1
- src/TextShow/Data/Functor/Product.hs +1/−1
- src/TextShow/Data/Functor/Sum.hs +1/−1
- src/TextShow/Data/Integral.hs +3/−14
- src/TextShow/Data/List.hs +1/−1
- src/TextShow/Data/List/NonEmpty.hs +2/−2
- src/TextShow/Data/Maybe.hs +1/−1
- src/TextShow/Data/Monoid.hs +7/−20
- src/TextShow/Data/OldTypeable.hs +0/−60
- src/TextShow/Data/Ord.hs +1/−1
- src/TextShow/Data/Proxy.hs +3/−6
- src/TextShow/Data/Ratio.hs +1/−1
- src/TextShow/Data/Semigroup.hs +2/−2
- src/TextShow/Data/Text.hs +12/−29
- src/TextShow/Data/Tuple.hs +26/−3
- src/TextShow/Data/Type/Coercion.hs +1/−8
- src/TextShow/Data/Type/Equality.hs +2/−10
- src/TextShow/Data/Typeable.hs +124/−64
- src/TextShow/Data/Typeable/Utils.hs +1/−1
- src/TextShow/Data/Version.hs +1/−1
- src/TextShow/Data/Void.hs +2/−2
- src/TextShow/Debug/Trace.hs +1/−4
- src/TextShow/Debug/Trace/Generic.hs +5/−5
- src/TextShow/Foreign/C/Types.hs +1/−1
- src/TextShow/Foreign/Ptr.hs +2/−2
- src/TextShow/FromStringTextShow.hs +81/−278
- src/TextShow/Functions.hs +1/−1
- src/TextShow/GHC/Conc/Windows.hs +3/−3
- src/TextShow/GHC/Event.hs +5/−13
- src/TextShow/GHC/Fingerprint.hs +2/−2
- src/TextShow/GHC/Generics.hs +5/−19
- src/TextShow/GHC/RTS/Flags.hs +21/−12
- src/TextShow/GHC/Stack.hs +3/−19
- src/TextShow/GHC/StaticPtr.hs +1/−8
- src/TextShow/GHC/Stats.hs +6/−2
- src/TextShow/GHC/TypeLits.hs +47/−53
- src/TextShow/Generic.hs +342/−297
- src/TextShow/Instances.hs +1/−1
- src/TextShow/Numeric/Natural.hs +6/−10
- src/TextShow/Options.hs +2/−23
- src/TextShow/System/Exit.hs +1/−1
- src/TextShow/System/IO.hs +1/−1
- src/TextShow/System/Posix/Types.hs +1/−1
- src/TextShow/TH.hs +1/−1
- src/TextShow/TH/Internal.hs +186/−109
- src/TextShow/Text/Read.hs +4/−12
- src/TextShow/Utils.hs +1/−18
- tests/Derived/DataFamilies.hs +4/−68
- tests/Derived/DatatypeContexts.hs +3/−20
- tests/Derived/ExistentialQuantification.hs +2/−11
- tests/Derived/Infix.hs +4/−58
- tests/Derived/MagicHash.hs +55/−37
- tests/Derived/PolyKinds.hs +10/−136
- tests/Derived/RankNTypes.hs +5/−24
- tests/Derived/Records.hs +2/−45
- tests/Derived/TypeFamilies.hs +3/−19
- tests/Derived/TypeSynonyms.hs +7/−38
- tests/Instances/Control/Concurrent.hs +1/−1
- tests/Instances/Control/Exception.hs +1/−7
- tests/Instances/Control/Monad/ST.hs +1/−1
- tests/Instances/Data/Char.hs +4/−1
- tests/Instances/Data/Data.hs +1/−1
- tests/Instances/Data/Dynamic.hs +1/−1
- tests/Instances/Data/Floating.hs +3/−1
- tests/Instances/Data/Monoid.hs +1/−1
- tests/Instances/Data/OldTypeable.hs +0/−43
- tests/Instances/Data/Ord.hs +4/−1
- tests/Instances/Data/Semigroup.hs +5/−2
- tests/Instances/Data/Text.hs +6/−18
- tests/Instances/Data/Tuple.hs +2/−11
- tests/Instances/Data/Type/Coercion.hs +1/−7
- tests/Instances/Data/Type/Equality.hs +2/−9
- tests/Instances/Data/Typeable.hs +20/−29
- tests/Instances/Foreign/C/Types.hs +1/−1
- tests/Instances/Foreign/Ptr.hs +1/−1
- tests/Instances/FromStringTextShow.hs +1/−1
- tests/Instances/GHC/Conc/Windows.hs +2/−2
- tests/Instances/GHC/Event.hs +4/−11
- tests/Instances/GHC/Fingerprint.hs +1/−1
- tests/Instances/GHC/Generics.hs +2/−8
- tests/Instances/GHC/RTS/Flags.hs +30/−21
- tests/Instances/GHC/Stack.hs +10/−28
- tests/Instances/GHC/StaticPtr.hs +1/−7
- tests/Instances/GHC/Stats.hs +2/−2
- tests/Instances/GHC/TypeLits.hs +26/−19
- tests/Instances/Generic.hs +2/−11
- tests/Instances/Options.hs +1/−1
- tests/Instances/System/IO.hs +10/−12
- tests/Instances/System/Posix/Types.hs +1/−1
- tests/Instances/Text/Read.hs +5/−25
- tests/Instances/Utils/GenericArbitrary.hs +1/−2
- tests/Spec/BuilderSpec.hs +11/−11
- tests/Spec/Control/ApplicativeSpec.hs +1/−3
- tests/Spec/Control/ConcurrentSpec.hs +1/−1
- tests/Spec/Control/ExceptionSpec.hs +1/−7
- tests/Spec/Control/Monad/STSpec.hs +1/−1
- tests/Spec/Data/Array/ByteSpec.hs +40/−0
- tests/Spec/Data/ArraySpec.hs +3/−3
- tests/Spec/Data/BoolSpec.hs +1/−1
- tests/Spec/Data/ByteStringSpec.hs +1/−1
- tests/Spec/Data/CharSpec.hs +1/−1
- tests/Spec/Data/ComplexSpec.hs +1/−1
- tests/Spec/Data/DataSpec.hs +1/−1
- tests/Spec/Data/DynamicSpec.hs +1/−1
- tests/Spec/Data/EitherSpec.hs +1/−2
- tests/Spec/Data/FixedSpec.hs +4/−4
- tests/Spec/Data/FloatingSpec.hs +3/−3
- tests/Spec/Data/Functor/ComposeSpec.hs +1/−1
- tests/Spec/Data/Functor/IdentitySpec.hs +1/−1
- tests/Spec/Data/Functor/ProductSpec.hs +1/−1
- tests/Spec/Data/Functor/SumSpec.hs +1/−1
- tests/Spec/Data/IntegralSpec.hs +8/−9
- tests/Spec/Data/List/NonEmptySpec.hs +2/−2
- tests/Spec/Data/ListSpec.hs +4/−4
- tests/Spec/Data/MaybeSpec.hs +1/−1
- tests/Spec/Data/MonoidSpec.hs +1/−5
- tests/Spec/Data/OldTypeableSpec.hs +0/−47
- tests/Spec/Data/OrdSpec.hs +1/−3
- tests/Spec/Data/ProxySpec.hs +1/−3
- tests/Spec/Data/RatioSpec.hs +1/−1
- tests/Spec/Data/SemigroupSpec.hs +2/−2
- tests/Spec/Data/TextSpec.hs +1/−11
- tests/Spec/Data/TupleSpec.hs +14/−2
- tests/Spec/Data/Type/CoercionSpec.hs +5/−13
- tests/Spec/Data/Type/EqualitySpec.hs +1/−4
- tests/Spec/Data/TypeableSpec.hs +7/−8
- tests/Spec/Data/VersionSpec.hs +4/−4
- tests/Spec/Derived/DataFamiliesSpec.hs +4/−20
- tests/Spec/Derived/DatatypeContextsSpec.hs +1/−1
- tests/Spec/Derived/ExistentialQuantificationSpec.hs +1/−1
- tests/Spec/Derived/InfixSpec.hs +1/−1
- tests/Spec/Derived/MagicHashSpec.hs +5/−1
- tests/Spec/Derived/PolyKindsSpec.hs +1/−1
- tests/Spec/Derived/RankNTypesSpec.hs +1/−1
- tests/Spec/Derived/RecordsSpec.hs +7/−1
- tests/Spec/Derived/TypeFamiliesSpec.hs +1/−11
- tests/Spec/Derived/TypeSynonymsSpec.hs +1/−1
- tests/Spec/Foreign/C/TypesSpec.hs +1/−1
- tests/Spec/Foreign/PtrSpec.hs +1/−1
- tests/Spec/FromStringTextShowSpec.hs +5/−22
- tests/Spec/FunctionsSpec.hs +1/−1
- tests/Spec/GHC/Conc/WindowsSpec.hs +3/−3
- tests/Spec/GHC/EventSpec.hs +4/−9
- tests/Spec/GHC/FingerprintSpec.hs +1/−1
- tests/Spec/GHC/GenericsSpec.hs +8/−31
- tests/Spec/GHC/RTS/FlagsSpec.hs +14/−15
- tests/Spec/GHC/StackSpec.hs +5/−19
- tests/Spec/GHC/StaticPtrSpec.hs +6/−13
- tests/Spec/GHC/StatsSpec.hs +2/−2
- tests/Spec/GHC/TypeLitsSpec.hs +20/−28
- tests/Spec/GenericSpec.hs +1/−1
- tests/Spec/Numeric/NaturalSpec.hs +2/−2
- tests/Spec/OptionsSpec.hs +1/−1
- tests/Spec/System/ExitSpec.hs +1/−1
- tests/Spec/System/IOSpec.hs +1/−1
- tests/Spec/System/Posix/TypesSpec.hs +1/−1
- tests/Spec/Text/ReadSpec.hs +3/−12
- tests/Spec/Utils.hs +77/−42
- text-show.cabal +89/−141
CHANGELOG.md view
@@ -1,3 +1,159 @@+### 3.11.4 [2026.06.19]+* Make the test suite report source locations for test failures accurately.++### 3.11.3 [2026.01.08]+* Make the test suite pass with `base-4.22.*` (GHC 9.14).+* Support building the test suite with `QuickCheck-2.17.*`.++### 3.11.2 [2025.06.17]+* Support building with the GHC JavaScript backend.++### 3.11.1 [2024.12.28]+* Make the test suite pass with `base-4.21.*` (GHC 9.12).++## 3.11 [2024.10.23]+* Support building with GHC 9.12.+* Add a `TextShow` instance for `IoManagerFlag` in `TextShow.GHC.RTS.Flags`+ (if building with `base-4.21`/GHC 9.12 or later).+* Drop support for pre-8.0 versions of GHC.+* Remove `TextShow.Data.OldTypeable`. The code in this module only worked with+ old versions of GHC that are no longer supported.++### 3.10.5 [2024.04.20]+* Support building with GHC 9.10.+* Ensure that the `TextShow` instance for `TypeRep` properly displays unboxed+ tuple `TypeRep` values.+* Add a `TextShow` instance for `HpcFlags` (in `TextShow.GHC.RTS.Flags`) when+ building with GHC 9.10 or later.++### 3.10.4 [2023.08.06]+* Support building with GHC 9.8.+* Ensure that the `TextShow` instance for `TypeRep` properly displays+ `TypeRep []` as `"[]"`.+* Ensure that the `TextShow` instance for `TypeRep` properly handles partial+ applications of tuple constructors (e.g., `(,) Int`).+* Support deriving `TextShow(1)(2)` instances for data types with fields+ of type `Int64#` or `Word64#` on GHC 9.8 or later.+* When generating `TextShow(1)(2)` instances with `TextShow.TH` using GHC 9.8 or+ later, data types that have fields of type `Int{8,16,32,64}#` or+ `Word{8,16,32,64}#` will be printed using extended literal syntax, mirroring+ corresponding changes introduced in GHC 9.8 (see+ https://github.com/ghc-proposals/ghc-proposals/pull/596).++### 3.10.3 [2023.06.03]+* Support building with `QuickCheck-2.14.3` in the test suite.++### 3.10.2 [2023.03.05]+* Allow building with GHC 9.6.+* Add `TextShow` instances for `SomeChar` (if building with `base-4.16` or+ later), as well as `SNat`, `SSymbol`, and `SChar` (if building with+ `base-4.18` or later).++### 3.10.1 [2023.02.27]+* Support `th-abstraction-0.5.*`.++## 3.10 [2022.10.05]+* The instances in `TextShow.FromStringTextShow` module have been scaled back+ somewhat for forward compatibility with Core Libraries proposal #10, which+ will add quantified `Show` superclasses to `Show1` and `Show2`:+ * `FromStringShow` and `FromTextShow` no longer have `Show1` or `TextShow1`+ instances. If you want to derive instances of `Show1` or `TextShow1` via+ a newtype, use `FromStringShow1` or `FromTextShow1` instead.+ * The `Show` instances for `FromTextShow1` and `FromTextShow2` have had their+ instance contexts changed to accommodate the new superclasses in `Show1`+ and `Show2`:++ ```diff+ -instance (TextShow1 f, TextShow a) => Show (FromTextShow1 f a)+ +instance (TextShow1 f, Show a) => Show (FromTextShow1 f a)++ -instance (TextShow2 f, TextShow a, TextShow b) => Show (FromTextShow2 f a b)+ +instance (TextShow2 f, Show a, Show b) => Show (FromTextShow2 f a b)+ ```++ While these instances do technically work, they are probably not what you+ would have in mind if you wanted to derive a `Show` instance purely in+ terms of `TextShow` classes. For this reason, if you want to derive an+ instance of `Show` via a newtype, use `FromTextShow` instead.+ * By similar reasoning, the `Show1` instance for `FromTextShow2` has had its+ instance context changed:++ ```diff+ -instance (TextShow2 f, TextShow a) => Show1 (FromTextShow2 f a)+ +instance (TextShow2 f, Show a) => Show1 (FromTextShow2 f a)+ ```+ * By similar reasoning, the `TextShow` instances for `FromStringShow1` and+ `FromStringShow2`, as well as the `TextShow1` instance for+ `FromStringShow2`, have had their instance contexts changed:++ ```diff+ -instance (Show1 f, Show a) => TextShow (FromStringShow1 f a)+ +instance (Show1 f, TextShow a) => TextShow (FromStringShow1 f a)++ -instance (Show2 f, Show a, Show b) => TextShow (FromStringShow2 f a b)+ +instance (Show2 f, TextShow a, TextShow b) => TextShow (FromStringShow2 f a b)++ -instance (Show2 f, Show a) => TextShow1 (FromStringShow2 f a)+ +instance (Show2 f, TextShow a) => TextShow1 (FromStringShow2 f a)+ ```+* The `TextShow{1,2}` classes now have quantified superclasses:++ ```hs+ class (forall a. TextShow a => TextShow (f a)) => TextShow1 f where ...+ class (forall a. TextShow a => TextShow1 (f a)) => TextShow2 f where ...+ ```++ This mirrors corresponding changes made to `Show1` and `Show2` in the `base`+ library. See https://github.com/haskell/core-libraries-committee/issues/10.++ Because of this change, any code that defines a `TextShow1` instance for a+ data type without a corresponding `TextShow` instance will no longer compile,+ so you may need to define more `TextShow` instances to adapt to this change.+ Similarly, `TextShow2` instances will now also require corresponding+ `TextShow` and `TextShow1` instances.+* The `GTextShow*` classes in `TextShow.Generic`, which power generic+ derivation of `TextShow` and `TextShow1` instances, have been split up to+ facilitate the addition of a quantified superclass to `TextShow1`. Moreover,+ the `ShowFuns*` data types, the `Zero` data type, and the `One data type have+ been removed, as they are no longer necessary in light of this split.++ Although this is a breaking API change, the changes should be invisible to+ most users of the module, especially if your code only uses it to derive+ `TextShow{,1}` instances.+* Add a `TextShow` instance for `ByteArray` from `Data.Array.Byte` when+ building with `base-4.17.0.0` or later.++### 3.9.7 [2022.05.28]+* Allow the test suite to build with GHC 9.4.+* Allow building with `transformers-0.6.*`.++### 3.9.6 [2022.01.14]+* `text-show` no longer depends on `integer-gmp` when built with GHC 9.0 or+ later. When building with older versions of GHC, the `integer-gmp` dependency+ can be toggled by disabling the `integer-gmp` `cabal` flag.++### 3.9.5 [2022.01.03]+* Work around a GHC 8.0–specific issue in which GHC's simplifier ticks would+ become exhausted, causing compilation to fail.++### 3.9.4 [2021.12.26]+* Allow the test suite to build with `text-2.0.*` and+ `transformers-compat-0.7.1`.++### 3.9.3 [2021.10.31]+* Allow building with GHC 9.2.+* Drop support for GHC 7.4 and 7.6.+* Add `TextShow(1)` instances for `Solo` when building with `ghc-prim-0.7` or+ later.+* Support deriving `TextShow(1)(2)` instances for data types with fields+ of type `Int32#` or `Word32#` on GHC 8.2 or later.++### 3.9.2 [2021.08.30]+* Require `generic-deriving-1.14.1` or later in the test suite.++### 3.9.1 [2021.08.29]+* Require `base-orphans-0.8.5` or later in the test suite.+ ## 3.9 [2020.10.03] * Allow building with GHC 9.0. * Remove `TextShow(1)` instances for `Data.Semigroup.Option`, which is
README.md view
@@ -1,10 +1,8 @@ # `text-show` [][Hackage: text-show]-[](http://packdeps.haskellers.com/reverse/text-show) [][Haskell.org] [][tl;dr Legal: BSD3]-[](https://travis-ci.org/RyanGlScott/text-show)-[](https://ci.appveyor.com/project/RyanGlScott/text-show)+[](https://github.com/RyanGlScott/text-show/actions?query=workflow%3AHaskell-CI) [Hackage: text-show]: http://hackage.haskell.org/package/text-show@@ -18,8 +16,6 @@ `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@@ -34,3 +30,18 @@ See also the [naming conventions](https://github.com/RyanGlScott/text-show/wiki/Naming-conventions) page. Support for automatically deriving `TextShow` instances can be found in the `TextShow.TH` and `TextShow.Generic` modules.++## Scope of the library++`text-show` only provides instances for data types in the following packages:++* [`array`](http://hackage.haskell.org/package/array)+* [`base`](http://hackage.haskell.org/package/base)+* [`bytestring`](http://hackage.haskell.org/package/bytestring)+* [`text`](http://hackage.haskell.org/package/text)++This policy is in place to keep `text-show`'s dependencies reasonably light. If+you need a `TextShow` instance for a library that is not in this list, it may+be covered by the+[`text-show-instances`](https://github.com/RyanGlScott/text-show-instances)+library.
benchmarks/Bench.hs view
@@ -18,7 +18,7 @@ import Criterion.Main (Benchmark, bench, bgroup, defaultMain, nf) -import Data.List (foldl')+import qualified Data.Foldable as F import qualified Data.Text as T import GHC.Generics (Generic)@@ -121,12 +121,12 @@ mediumSample :: Sample mediumSample (leaf, branch, empty, showFun) =- showFun . foldl' branch empty . replicate 1000 $ sampleTree leaf branch+ showFun . F.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+ showFun . F.foldl' branch empty . replicate 100000 $ sampleTree leaf branch {-# NOINLINE largeSample #-} sampleTree :: (Int -> a) -> (a -> a -> a) -> a
− include/generic.h
@@ -1,11 +0,0 @@-#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
− include/overlap.h
@@ -1,16 +0,0 @@-#ifndef OVERLAP_H-#define OVERLAP_H--#if __GLASGOW_HASKELL__ >= 710-# define __LANGUAGE_OVERLAPPING_INSTANCES__-# define __OVERLAPPABLE__ {-# OVERLAPPABLE #-}-# define __OVERLAPPING__ {-# OVERLAPPING #-}-# define __OVERLAPS__ {-# OVERLAPS #-}-#else-# define __LANGUAGE_OVERLAPPING_INSTANCES__ {-# LANGUAGE OverlappingInstances #-}-# define __OVERLAPPABLE__-# define __OVERLAPPING__-# define __OVERLAPS__-#endif--#endif
@@ -1,5 +1,5 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskellQuotes #-} {-| Module: TextShow.TH.Names@@ -17,32 +17,22 @@ fdKeyTypeName, uniqueTypeName, asInt64ValName,-#if MIN_VERSION_base(4,6,0)- numberTypeName,-#endif-#if MIN_VERSION_base(4,8,0) giveGCStatsTypeName, doCostCentresTypeName, doHeapProfileTypeName, doTraceTypeName,-#endif ) where -import Language.Haskell.TH.Syntax--#if MIN_VERSION_base(4,7,0)-import Text.Read.Lex (Number)-#endif--#if MIN_VERSION_base(4,8,2) import GHC.RTS.Flags (GiveGCStats, DoCostCentres, DoHeapProfile, DoTrace)-#endif+import Language.Haskell.TH.Syntax ------------------------------------------------------------------------------- -- | Creates a 'Name' for a value from the "GHC.Event.Internal" module. mkEventName_v :: String -> Name-#if MIN_VERSION_base(4,15,0)+#if MIN_VERSION_base(4,20,0)+mkEventName_v = mkNameG_v "ghc-internal" "GHC.Internal.Event.Internal.Types"+#elif MIN_VERSION_base(4,15,0) mkEventName_v = mkNameG_v "base" "GHC.Event.Internal.Types" #else mkEventName_v = mkNameG_v "base" "GHC.Event.Internal"@@ -58,66 +48,44 @@ -- | The 'Name' of 'FdKey'. fdKeyTypeName :: Name+#if MIN_VERSION_base(4,20,0)+fdKeyTypeName = mkNameG_tc "ghc-internal" "GHC.Internal.Event.Manager" "FdKey"+#else fdKeyTypeName = mkNameG_tc "base" "GHC.Event.Manager" "FdKey"+#endif -- | The 'Name' of 'Unique'. uniqueTypeName :: Name+#if MIN_VERSION_base(4,20,0)+uniqueTypeName = mkNameG_tc "ghc-internal" "GHC.Internal.Event.Unique" "Unique"+#else uniqueTypeName = mkNameG_tc "base" "GHC.Event.Unique" "Unique"+#endif -- | The 'Name' of 'asInt64' (or, 'asInt' on @base-4.10.0.0@ or later). asInt64ValName :: Name-#if MIN_VERSION_base(4,10,0)+#if MIN_VERSION_base(4,20,0)+asInt64ValName = mkNameG_fld "ghc-internal" "GHC.Internal.Event.Unique" "Unique" "asInt"+#elif MIN_VERSION_base(4,19,0)+asInt64ValName = mkNameG_fld "base" "GHC.Event.Unique" "Unique" "asInt"+#elif MIN_VERSION_base(4,10,0) asInt64ValName = mkNameG_v "base" "GHC.Event.Unique" "asInt" #else asInt64ValName = mkNameG_v "base" "GHC.Event.Unique" "asInt64" #endif -#if MIN_VERSION_base(4,6,0)--- | The 'Name' of 'Number'.-numberTypeName :: Name-# if MIN_VERSION_base(4,7,0)-numberTypeName = ''Number-# else-numberTypeName = mkNameG_tc "base" "Text.Read.Lex" "Number"-# endif-#endif--#if MIN_VERSION_base(4,8,0) -- | The 'Name' of 'GiveGCStats'. giveGCStatsTypeName :: Name-# if MIN_VERSION_base(4,8,2) giveGCStatsTypeName = ''GiveGCStats-# else-giveGCStatsTypeName = mkFlagsName_tc "GiveGCStats"-# endif -- | The 'Name' of 'DoCostCentres'. doCostCentresTypeName :: Name-# if MIN_VERSION_base(4,8,2) doCostCentresTypeName = ''DoCostCentres-# else-doCostCentresTypeName = mkFlagsName_tc "DoCostCentres"-# endif -- | The 'Name' of 'DoHeapProfile'. doHeapProfileTypeName :: Name-# if MIN_VERSION_base(4,8,2) doHeapProfileTypeName = ''DoHeapProfile-# else-doHeapProfileTypeName = mkFlagsName_tc "DoHeapProfile"-# endif -- | The 'Name' of 'DoTrace'. doTraceTypeName :: Name-# if MIN_VERSION_base(4,8,2) doTraceTypeName = ''DoTrace-# else-doTraceTypeName = mkFlagsName_tc "DoTrace"-# endif---- | Creates a 'Name' for a type from the "GHC.RTS.Flags" module.-# if !(MIN_VERSION_base(4,8,2))-mkFlagsName_tc :: String -> Name-mkFlagsName_tc = mkNameG_tc "base" "GHC.RTS.Flags"-# endif-#endif
src/TextShow/Classes.hs view
@@ -1,10 +1,10 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} -#if __GLASGOW_HASKELL__ >= 708-{-# LANGUAGE StandaloneDeriving #-}+#if __GLASGOW_HASKELL__ >= 806+{-# LANGUAGE QuantifiedConstraints #-} #endif+ {-| Module: TextShow.Classes Copyright: (C) 2014-2017 Ryan Scott@@ -17,9 +17,6 @@ -} module TextShow.Classes where -#if __GLASGOW_HASKELL__ >= 708-import Data.Data (Typeable)-#endif 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)@@ -175,12 +172,8 @@ -> 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/@@ -399,7 +392,11 @@ -- | Lifting of the 'TextShow' class to unary type constructors. -- -- /Since: 2/-class TextShow1 f where+class+#if __GLASGOW_HASKELL__ >= 806+ (forall a. TextShow a => TextShow (f a)) =>+#endif+ TextShow1 f where -- | 'showbPrec' function for an application of the type constructor -- based on 'showbPrec' and 'showbList' functions for the argument type. --@@ -417,12 +414,8 @@ -> [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. --@@ -466,7 +459,21 @@ -- | Lifting of the 'TextShow' class to binary type constructors. -- -- /Since: 2/-class TextShow2 f where+class+#if __GLASGOW_HASKELL__ >= 806+ ( forall a. TextShow a => TextShow1 (f a)+# if __GLASGOW_HASKELL__ < 900+ -- Sadly, pre-9.0 versions of GHC have difficulty inferring this+ -- superclass from the one above due to+ -- https://gitlab.haskell.org/ghc/ghc/-/issues/17202.+ -- As a workaround, we manually expand the superclass above to assist+ -- type inference. Without doing this, the text-show test suite would+ -- not compile on pre-9.0 versions of GHC.+ , forall a b. (TextShow a, TextShow b) => TextShow (f a b)+# endif+ ) =>+#endif+ TextShow2 f where -- | 'showbPrec' function for an application of the type constructor -- based on 'showbPrec' and 'showbList' functions for the argument types. --@@ -487,11 +494,7 @@ 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. --
src/TextShow/Control/Applicative.hs view
@@ -1,12 +1,9 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}--#if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-}-#endif+{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Control.Applicative Copyright: (C) 2014-2017 Ryan Scott
src/TextShow/Control/Concurrent.hs view
@@ -3,7 +3,7 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE UnliftedFFITypes #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Control.Concurrent Copyright: (C) 2014-2017 Ryan Scott
src/TextShow/Control/Exception.hs view
@@ -5,7 +5,7 @@ #if __GLASGOW_HASKELL__ >= 806 {-# LANGUAGE DerivingVia #-} #endif-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Control.Exception Copyright: (C) 2014-2017 Ryan Scott@@ -23,7 +23,7 @@ import Control.Exception.Base import Data.Text.Lazy.Builder (fromString)-#if MIN_VERSION_base(4,9,0)+#if !MIN_VERSION_base(4,21,0) import Data.Text.Lazy.Builder (singleton) #endif @@ -59,9 +59,7 @@ showb LossOfPrecision = "loss of precision" showb DivideByZero = "divide by zero" showb Denormal = "denormal"-#if MIN_VERSION_base(4,6,0) showb RatioZeroDenominator = "Ratio has zero denominator"-#endif -- | /Since: 2/ instance TextShow ArrayException where@@ -80,14 +78,10 @@ showb (AssertionFailed err) = fromString err {-# INLINE showb #-} -#if MIN_VERSION_base(4,7,0)--- | Only available with @base-4.7.0.0@ or later.------ /Since: 2/+-- | /Since: 2/ instance TextShow SomeAsyncException where showb (SomeAsyncException e) = showb $ FromStringShow e {-# INLINE showb #-}-#endif -- | /Since: 2/ instance TextShow AsyncException where@@ -117,23 +111,15 @@ showb BlockedIndefinitelyOnSTM = "thread blocked indefinitely in an STM transaction" {-# INLINE showb #-} -#if MIN_VERSION_base(4,8,0)--- | Only available with @base-4.8.0.0@ or later.------ /Since: 2/+-- | /Since: 2/ instance TextShow AllocationLimitExceeded where showb AllocationLimitExceeded = "allocation limit exceeded" {-# INLINE showb #-}-#endif -#if MIN_VERSION_base(4,9,0)--- | Only available with @base-4.9.0.0@ or later.------ /Since: 3/+-- | /Since: 3/ instance TextShow TypeError where showb (TypeError err) = fromString err {-# INLINE showb #-}-#endif #if MIN_VERSION_base(4,10,0) -- | Only available with @base-4.10.0.0@ or later.@@ -183,12 +169,12 @@ -- | /Since: 2/ instance TextShow ErrorCall where-#if MIN_VERSION_base(4,9,0)+#if MIN_VERSION_base(4,21,0)+ showb (ErrorCall err) = fromString err+#else showb (ErrorCallWithLocation err "") = fromString err showb (ErrorCallWithLocation err loc) = fromString err <> singleton '\n' <> fromString loc-#else- showb (ErrorCall err) = fromString err #endif -- | /Since: 2/
src/TextShow/Control/Monad/ST.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Control.Monad.ST Copyright: (C) 2014-2017 Ryan Scott
src/TextShow/Data/Array.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Array Copyright: (C) 2014-2017 Ryan Scott@@ -34,10 +34,6 @@ import TextShow.Data.List () import TextShow.Data.Tuple () -{-# SPECIALIZE- showbIArrayPrec :: (IArray UArray e, Ix i, TextShow i, TextShow e) =>- Int -> UArray i e -> Builder- #-} -- | Convert an 'IArray' instance to a 'Builder' with the given precedence. -- -- /Since: 2/
+ src/TextShow/Data/Array/Byte.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# OPTIONS_GHC -Wno-orphans #-}+{-|+Module: TextShow.Data.Array.Byte+Copyright: (C) 2022 Ryan Scott+License: BSD-style (see the file LICENSE)+Maintainer: Ryan Scott+Stability: Provisional+Portability: GHC++Provides a 'TextShow' instance for 'ByteArray' from the "Data.Array.Byte"+module. Only provided if using @base-4.17.0.0@ or later.++/Since: 3.10/+-}+module TextShow.Data.Array.Byte () where++#if MIN_VERSION_base(4,17,0)+import Data.Array.Byte (ByteArray(..))+import Data.Bits (Bits(..))+import Data.Char (intToDigit)+import Data.Text.Lazy.Builder (Builder, fromString, singleton)++import GHC.Exts (Int(..), indexWord8Array#, sizeofByteArray#)+import GHC.Word (Word8(..))++import Prelude ()+import Prelude.Compat++import TextShow.Classes (TextShow(..))++-- | /Since: 3.10/+instance TextShow ByteArray where+ showbPrec _ ba =+ fromString "[" <> go 0+ where+ showW8 :: Word8 -> Builder+ showW8 !w =+ singleton '0'+ <> singleton 'x'+ <> singleton (intToDigit (fromIntegral (unsafeShiftR w 4)))+ <> singleton (intToDigit (fromIntegral (w .&. 0x0F)))+ go i+ | i < sizeofByteArray ba = comma <> showW8 (indexByteArray ba i :: Word8) <> go (i+1)+ | otherwise = singleton ']'+ where+ comma | i == 0 = mempty+ | otherwise = fromString ", "++-- | Read byte at specific index.+indexByteArray :: ByteArray -> Int -> Word8+{-# INLINE indexByteArray #-}+indexByteArray (ByteArray arr#) (I# i#) = W8# (indexWord8Array# arr# i#)++-- | Size of the byte array in bytes.+sizeofByteArray :: ByteArray -> Int+{-# INLINE sizeofByteArray #-}+sizeofByteArray (ByteArray arr#) = I# (sizeofByteArray# arr#)+#endif
src/TextShow/Data/Bool.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Bool Copyright: (C) 2014-2017 Ryan Scott
src/TextShow/Data/ByteString.hs view
@@ -1,10 +1,6 @@ {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-}-#if !(MIN_VERSION_bytestring(0,10,0))-{-# LANGUAGE TemplateHaskell #-}-#endif-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.ByteString@@ -31,16 +27,6 @@ import TextShow.Data.Char () import TextShow.Data.List () -#if !(MIN_VERSION_bytestring(0,10,0))-import Data.Word (Word8)--import Foreign.ForeignPtr (withForeignPtr)-import Foreign.Ptr (plusPtr)-import Foreign.Storable (peek, peekByteOff)--import TextShow.TH.Internal (deriveTextShow)-#endif- ------------------------------------------------------------------------ -- Primop wrappers @@ -59,31 +45,12 @@ -- | /Since: 2/ instance TextShow BS.ByteString where {-# INLINE showb #-}-#if MIN_VERSION_bytestring(0,10,0) showb = showb . BS.unpackChars-#else- showb = showb . unpackWith BS.w2c --- | /O(n)/ Converts a 'ByteString' to a '[a]', using a conversion function.-unpackWith :: (Word8 -> a) -> BS.ByteString -> [a]-unpackWith _ (BS.PS _ _ 0) = []-unpackWith k (BS.PS ps s l) = BS.inlinePerformIO $ withForeignPtr ps $ \p ->- go (p `plusPtr` s) (l - 1) []- where- go !p !0 !acc = peek p >>= \e -> return (k e : acc)- go !p !n !acc = peekByteOff p n >>= \e -> go p (n-1) (k e : acc)-{-# INLINE unpackWith #-}-#endif--#if MIN_VERSION_bytestring(0,10,0) -- | /Since: 2/ instance TextShow BL.ByteString where showb = showb . BL.unpackChars {-# INLINE showb #-}-#else--- | /Since: 2/-$(deriveTextShow ''BL.ByteString)-#endif -- | /Since: 2/ instance TextShow ShortByteString where
src/TextShow/Data/Char.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Char Copyright: (C) 2014-2017 Ryan Scott
src/TextShow/Data/Complex.hs view
@@ -1,5 +1,10 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-}+#if __GLASGOW_HASKELL__ == 800+-- See Note [Increased simpl-tick-factor on old GHCs]+{-# OPTIONS_GHC -fsimpl-tick-factor=200 #-}+#endif {-| Module: TextShow.Data.Ratio@@ -30,3 +35,22 @@ -- | /Since: 2/ $(deriveTextShow1 ''Complex)++{-+Note [Increased simpl-tick-factor on old GHCs]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++Compiling certain text-show modules with optimizations on old versions of GHC+(particularly 8.0 and 8.2) will trigger "Simplifier ticks exhausted" panics.+To make things worse, this sometimes depends on whether a certain version of+the text library is being used. There are two possible ways to work around+this issue:++1. Figure out which uses of the INLINE pragma in text-show are responsible+ and remove them.+2. Just increase the tick limit.++Since executing on (1) will require a lot of effort to fix an issue that only+happens on old versions of GHC, I've opted for the simple solution of (2) for+now. Issue #51 is a reminder to revisit this choice.+-}
src/TextShow/Data/Data.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Data Copyright: (C) 2014-2017 Ryan Scott
src/TextShow/Data/Dynamic.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Dynamic Copyright: (C) 2014-2017 Ryan Scott
src/TextShow/Data/Either.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Either Copyright: (C) 2014-2017 Ryan Scott
src/TextShow/Data/Fixed.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Fixed Copyright: (C) 2014-2017 Ryan Scott@@ -14,26 +14,17 @@ -} module TextShow.Data.Fixed (showbFixed) where -import Data.Fixed (HasResolution(..))-import Data.Text.Lazy.Builder (Builder)+import Data.Fixed (Fixed(..), HasResolution(..))+import Data.Int (Int64)+import Data.Semigroup (mtimesDefault)+import Data.Text.Lazy.Builder (Builder, singleton) 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.Semigroup.Compat (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 #if MIN_VERSION_base(4,13,0) import TextShow.Classes (showbParen)@@ -44,7 +35,6 @@ -- -- /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)@@ -54,18 +44,9 @@ (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@@ -87,7 +68,6 @@ withDotB b | b == mempty = mempty | otherwise = singleton '.' <> b {-# INLINE withDotB #-}-#endif -- | /Since: 2/ instance HasResolution a => TextShow (Fixed a) where
src/TextShow/Data/Floating.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Floating Copyright: (C) 2014-2017 Ryan Scott@@ -71,15 +71,12 @@ | otherwise = showbGFloat Nothing x {-# INLINE showbRealFloatPrec #-} -{-# SPECIALIZE showbEFloat ::- Maybe Int -> Float -> Builder,- Maybe Int -> Double -> Builder #-}-{-# SPECIALIZE showbFFloat ::- Maybe Int -> Float -> Builder,- Maybe Int -> Double -> Builder #-}-{-# SPECIALIZE showbGFloat ::- Maybe Int -> Float -> Builder,- Maybe Int -> Double -> Builder #-}+{-# SPECIALIZE showbEFloat :: Maybe Int -> Float -> Builder #-}+{-# SPECIALIZE showbEFloat :: Maybe Int -> Double -> Builder #-}+{-# SPECIALIZE showbFFloat :: Maybe Int -> Float -> Builder #-}+{-# SPECIALIZE showbFFloat :: Maybe Int -> Double -> Builder #-}+{-# SPECIALIZE showbGFloat :: Maybe Int -> Float -> Builder #-}+{-# SPECIALIZE showbGFloat :: Maybe Int -> Double -> Builder #-} -- | Show a signed 'RealFloat' value -- using scientific (exponential) notation (e.g. @2.45e2@, @1.5e-3@).@@ -204,7 +201,9 @@ _ -> let (ei,is') = roundTo 1 is- n:_ = map i2d (if ei > 0 then init is' else is')+ n = case map i2d (if ei > 0 then init is' else is') of+ n':_ -> n'+ [] -> error "formatRealFloatAltB (Exponent, negative decs): Unexpected empty list" in singleton n <> singleton 'e' <> decimal (e-1+ei) Just dec -> let dec' = max dec 1 in@@ -213,7 +212,9 @@ _ -> let (ei,is') = roundTo (dec'+1) is- (d:ds') = map i2d (if ei > 0 then init is' else is')+ (d,ds') = case map i2d (if ei > 0 then init is' else is') of+ (d':ds'') -> (d',ds'')+ [] -> error "formatRealFloatAltB (Exponent, non-negative decs): Unexpected empty list" in singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> decimal (e-1+ei) Fixed ->@@ -241,7 +242,9 @@ else let (ei,is') = roundTo dec' (replicate (-e) 0 ++ is)- d:ds' = map i2d (if ei > 0 then is' else 0:is')+ (d,ds') = case map i2d (if ei > 0 then is' else 0:is') of+ (d':ds'') -> (d',ds'')+ [] -> error "formatRealFloatAltB (Fixed): Unexpected empty list" in singleton d <> (if null ds' && not alt then "" else singleton '.' <> fromString ds') @@ -355,7 +358,6 @@ (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@@ -374,22 +376,6 @@ (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.
src/TextShow/Data/Functor/Compose.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Functor.Compose
src/TextShow/Data/Functor/Identity.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Functor.Identity Copyright: (C) 2014-2017 Ryan Scott
src/TextShow/Data/Functor/Product.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Functor.Product
src/TextShow/Data/Functor/Sum.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Functor.Sum
src/TextShow/Data/Integral.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Integral Copyright: (C) 2014-2017 Ryan Scott@@ -28,10 +28,7 @@ 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 (Int#, isTrue#)-#endif+import GHC.Exts (Int(I#), (<#), (>#), isTrue#) import Prelude () import Prelude.Compat@@ -102,18 +99,10 @@ -- | /Since: 2/ instance TextShow Int where showbPrec (I# p) n'@(I# n)- | isTrue (n <# 0#) && isTrue (p ># 6#)+ | isTrue# (n <# 0#) && isTrue# (p ># 6#) = singleton '(' <> decimal n' <> singleton ')' | otherwise = decimal n'- where-#if __GLASGOW_HASKELL__ >= 708- isTrue :: Int# -> Bool- isTrue b = isTrue# b-#else- isTrue :: Bool -> Bool- isTrue = id-#endif -- | /Since: 2/ instance TextShow Int8 where
src/TextShow/Data/List.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.List Copyright: (C) 2014-2017 Ryan Scott
src/TextShow/Data/List/NonEmpty.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.List.NonEmpty@@ -15,7 +15,7 @@ -} module TextShow.Data.List.NonEmpty () where -import Data.List.NonEmpty.Compat (NonEmpty)+import Data.List.NonEmpty (NonEmpty) import TextShow.Data.List () import TextShow.TH.Internal (deriveTextShow, deriveTextShow1)
src/TextShow/Data/Maybe.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Maybe Copyright: (C) 2014-2017 Ryan Scott
src/TextShow/Data/Monoid.hs view
@@ -1,9 +1,7 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE TemplateHaskell #-}-#if MIN_VERSION_base(4,8,0) {-# LANGUAGE FlexibleContexts #-}-#endif-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Monoid Copyright: (C) 2014-2017 Ryan Scott@@ -18,17 +16,12 @@ -} module TextShow.Data.Monoid () where -import Data.Monoid.Compat (All, Any, Dual, First, Last, Product, Sum)+import Data.Monoid (All, Alt, Any, Dual, First, Last, Product, Sum) +import TextShow.Classes (TextShow(..)) import TextShow.Data.Bool () import TextShow.Data.Maybe ()-import TextShow.TH.Internal (deriveTextShow, deriveTextShow1)--#if MIN_VERSION_base(4,8,0)-import Data.Monoid (Alt)-import TextShow.Classes (TextShow(..))-import TextShow.TH.Internal (makeShowbPrec)-#endif+import TextShow.TH.Internal (deriveTextShow, deriveTextShow1, makeShowbPrec) #if MIN_VERSION_base(4,12,0) import Data.Monoid (Ap)@@ -59,18 +52,12 @@ -- | /Since: 2/ $(deriveTextShow1 ''Sum) -#if MIN_VERSION_base(4,8,0)--- | Only available with @base-4.8.0.0@ or later.------ /Since: 2/+-- | /Since: 2/ instance TextShow (f a) => TextShow (Alt f a) where showbPrec = $(makeShowbPrec ''Alt) --- | Only available with @base-4.8.0.0@ or later.------ /Since: 2/+-- | /Since: 2/ $(deriveTextShow1 ''Alt)-#endif #if MIN_VERSION_base(4,12,0) -- | Only available with @base-4.12.0.0@ or later.
− src/TextShow/Data/OldTypeable.hs
@@ -1,60 +0,0 @@-{-# LANGUAGE CPP #-}--#if MIN_VERSION_base(4,7,0) && !(MIN_VERSION_base(4,8,0))-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-warnings-deprecations #-}-#endif-{-|-Module: TextShow.Data.OldTypeable-Copyright: (C) 2014-2017 Ryan Scott-License: BSD-style (see the file LICENSE)-Maintainer: Ryan Scott-Stability: Provisional-Portability: GHC--'TextShow' instances for data types in the @OldTypeable@ module.-This module only exports functions if using @base-4.7@.--/Since: 2/--}-module TextShow.Data.OldTypeable () where--#if MIN_VERSION_base(4,7,0) && !(MIN_VERSION_base(4,8,0))-import Data.OldTypeable.Internal (TyCon(TyCon, tyConName), TypeRep(..),- funTc, listTc)-import Data.Text.Lazy.Builder (fromString, singleton)--import Prelude ()-import Prelude.Compat--import TextShow.Classes (TextShow(..), showbParen, showbSpace)-import TextShow.Data.Typeable.Utils (showbArgs, showbTuple)-import TextShow.Utils (isTupleString)---- | Does the 'TyCon' represent a tuple type constructor?-isTupleTyCon :: TyCon -> Bool-isTupleTyCon (TyCon _ _ _ str) = isTupleString str-{-# INLINE isTupleTyCon #-}---- | /Since: 2/-instance TextShow TyCon where- showb = fromString . tyConName- {-# INLINE showb #-}---- | /Since: 2/-instance TextShow TypeRep where- showbPrec p (TypeRep _ tycon tys) =- case tys of- [] -> showb tycon- [x] | tycon == listTc -> singleton '[' <> showb x <> singleton ']'- [a,r] | tycon == funTc -> showbParen (p > 8) $- showbPrec 9 a- <> " -> "- <> showbPrec 8 r- xs | isTupleTyCon tycon -> showbTuple xs- | otherwise -> showbParen (p > 9) $- showbPrec p tycon- <> showbSpace- <> showbArgs showbSpace tys- {-# INLINE showbPrec #-}-#endif
src/TextShow/Data/Ord.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Ord Copyright: (C) 2014-2017 Ryan Scott
src/TextShow/Data/Proxy.hs view
@@ -1,12 +1,9 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}--#if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-}-#endif+{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Proxy@@ -22,7 +19,7 @@ -} module TextShow.Data.Proxy () where -import Data.Proxy.Compat (Proxy)+import Data.Proxy (Proxy) import TextShow.Classes (TextShow(..)) import TextShow.TH.Internal (deriveTextShow1, makeShowbPrec,
src/TextShow/Data/Ratio.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Ratio
src/TextShow/Data/Semigroup.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Semigroup@@ -15,7 +15,7 @@ -} module TextShow.Data.Semigroup () where -import Data.Semigroup.Compat (Min, Max, First, Last, WrappedMonoid, Arg)+import Data.Semigroup (Min, Max, First, Last, WrappedMonoid, Arg) import TextShow.Data.Maybe () import TextShow.TH.Internal (deriveTextShow, deriveTextShow1, deriveTextShow2)
src/TextShow/Data/Text.hs view
@@ -1,10 +1,7 @@-{-# 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 #-}+{-# OPTIONS_GHC -Wno-deprecations #-} -- TODO: Remove this later+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Text Copyright: (C) 2014-2017 Ryan Scott@@ -26,30 +23,24 @@ module TextShow.Data.Text () where import qualified Data.Text as TS+import Data.Text.Encoding (Decoding(..)) import Data.Text.Encoding.Error (UnicodeException(..))+import Data.Text.Internal.Fusion.Size (Size) import qualified Data.Text.Lazy as TL-import Data.Text.Lazy.Builder (Builder, fromString, toLazyText)+import Data.Text.Lazy.Builder (Builder, fromString, singleton,+ toLazyText) +import GHC.Show (appPrec)+ import Prelude () import Prelude.Compat -import TextShow.Classes (TextShow(..))+import TextShow.Classes (TextShow(..), showbParen)+import TextShow.Data.ByteString () import TextShow.Data.Char (showbString) import TextShow.Data.Integral (showbHex) import TextShow.TH.Internal (deriveTextShow) -#if MIN_VERSION_text(1,0,0)-import Data.Text.Encoding (Decoding(..))-import Data.Text.Lazy.Builder (singleton)-import GHC.Show (appPrec)-import TextShow.Classes (showbParen)-import TextShow.Data.ByteString ()-#endif--#if MIN_VERSION_text(1,1,0)-import Data.Text.Internal.Fusion.Size (Size)-#endif- -- | /Since: 2/ instance TextShow TS.Text where showb = showbString . TS.unpack@@ -76,21 +67,13 @@ showb (EncodeError desc Nothing) = "Cannot encode input: " <> fromString desc -#if MIN_VERSION_text(1,0,0)--- | Only available with @text-1.0.0.0@ or later.------ /Since: 2/+-- | /Since: 2/ instance TextShow Decoding where showbPrec p (Some t bs _) = showbParen (p > appPrec) $ "Some " <> showb t <> singleton ' ' <> showb bs <> " _" {-# INLINE showbPrec #-}-#endif -#if MIN_VERSION_text(1,1,0)--- | Only available with @text-1.1.0.0@ or later.------ /Since: 2/+-- | /Since: 2/ $(deriveTextShow ''Size)-#endif
src/TextShow/Data/Tuple.hs view
@@ -1,6 +1,7 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Tuple Copyright: (C) 2014-2017 Ryan Scott@@ -15,6 +16,12 @@ -} module TextShow.Data.Tuple () where +#if MIN_VERSION_ghc_prim(0,7,0)+import GHC.Tuple (Solo(..))+import TextShow.Classes (TextShow(..), TextShow1(..),+ showbPrec1, showbUnaryWith)+#endif+ import TextShow.TH.Internal (deriveTextShow, deriveTextShow1, deriveTextShow2) -- The Great Pyramids of Template Haskell@@ -106,3 +113,19 @@ $(deriveTextShow2 ''(,,,,,,,,,,,,,)) -- | /Since: 2/ $(deriveTextShow2 ''(,,,,,,,,,,,,,,))++#if MIN_VERSION_ghc_prim(0,7,0)+-- | /Since: 3.9.3/+instance TextShow a => TextShow (Solo a) where+ showbPrec = showbPrec1+ {-# INLINE showbPrec #-}++-- | /Since: 3.9.3/+instance TextShow1 Solo where+# if MIN_VERSION_ghc_prim(0,10,0)+ liftShowbPrec sp _ p (MkSolo x) = showbUnaryWith sp "MkSolo" p x+# else+ liftShowbPrec sp _ p (Solo x) = showbUnaryWith sp "Solo" p x+# endif+ {-# INLINE liftShowbPrec #-}+#endif
src/TextShow/Data/Type/Coercion.hs view
@@ -1,11 +1,7 @@-{-# LANGUAGE CPP #-}--#if MIN_VERSION_base(4,7,0) {-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-#endif+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Type.Coercion Copyright: (C) 2014-2017 Ryan Scott@@ -15,13 +11,11 @@ Portability: GHC 'TextShow' instance for representational equality.-Only provided if using @base-4.7.0.0@ or later. /Since: 2/ -} module TextShow.Data.Type.Coercion () where -#if MIN_VERSION_base(4,7,0) import Data.Type.Coercion (Coercion) import TextShow.Classes (TextShow1(..))@@ -36,4 +30,3 @@ -- | /Since: 2/ $(deriveTextShow2 ''Coercion)-#endif
src/TextShow/Data/Type/Equality.hs view
@@ -1,13 +1,8 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-}--#if __GLASGOW_HASKELL__ >= 706-{-# LANGUAGE PolyKinds #-}-#endif--{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Type.Equality Copyright: (C) 2014-2017 Ryan Scott@@ -17,7 +12,6 @@ Portability: GHC 'TextShow' instance for propositional equality.-Only provided if using @base-4.7.0.0@ or later. /Since: 2/ -}@@ -38,7 +32,6 @@ -- | /Since: 2/ $(deriveTextShow2 ''(:~:)) -#if MIN_VERSION_base(4,9,0) -- | /Since: 3.6/ $(deriveTextShow ''(:~~:)) @@ -48,4 +41,3 @@ -- | /Since: 3.6/ $(deriveTextShow2 ''(:~~:))-#endif
src/TextShow/Data/Typeable.hs view
@@ -2,18 +2,15 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MagicHash #-}-{-# LANGUAGE OverloadedStrings #-}--#if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-}-#endif+{-# LANGUAGE OverloadedStrings #-} #if __GLASGOW_HASKELL__ >= 801 {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeApplications #-} #endif -{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Typeable@@ -41,43 +38,42 @@ import GHC.Types (Module(..), TrName(..), TyCon(..), isTrue#) import TextShow.Classes (TextShow(..), TextShow1(..), showbParen, showbSpace)-import TextShow.Data.Typeable.Utils (showbArgs, showbTuple)-import TextShow.Utils (isTupleString)+import TextShow.Data.Typeable.Utils (showbArgs)+# if !(MIN_VERSION_base(4,20,0))+import TextShow.Data.Typeable.Utils (showbTuple)+#endif import Type.Reflection (pattern App, pattern Con, pattern Con', pattern Fun, SomeTypeRep(..), TypeRep, eqTypeRep, tyConName, typeRep, typeRepTyCon) #else /* !(MIN_VERSION_base(4,10,0) */-import Data.Text.Lazy.Builder (fromString, singleton)+import Data.Text.Lazy.Builder (Builder, fromString, singleton) import Data.Typeable (TypeRep, typeRepArgs, typeRepTyCon)-import Data.Typeable.Internal (tyConName)-# if MIN_VERSION_base(4,8,0)-import Data.Typeable.Internal (typeRepKinds)-# endif-# if MIN_VERSION_base(4,9,0)-import Data.Text.Lazy.Builder (Builder) import Data.Typeable.Internal (Proxy(..), Typeable,- TypeRep(TypeRep), typeRep)-import GHC.Exts (RuntimeRep(..), TYPE)-# else-import Data.Typeable.Internal (funTc, listTc)-# endif+ TypeRep(TypeRep), tyConName, typeRep,+ typeRepKinds) -# if MIN_VERSION_base(4,9,0)-import GHC.Exts (Addr#, Char(..), (+#), eqChar#, indexCharOffAddr#)+import GHC.Exts (Addr#, Char(..), RuntimeRep(..), TYPE,+ (+#), eqChar#, indexCharOffAddr#) import GHC.Types (TyCon(..), TrName(..), Module(..), isTrue#)-# else-import Data.Typeable.Internal (TyCon)-# endif import TextShow.Classes (TextShow(..), showbParen, showbSpace) import TextShow.Data.List () import TextShow.Data.Typeable.Utils (showbArgs, showbTuple)+#endif++#if MIN_VERSION_base(4,13,0)+import Type.Reflection (typeRepKind)+#endif++#if MIN_VERSION_base(4,19,0)+import Data.Char (isDigit, ord)+import Type.Reflection (tyConModule, tyConPackage)+#else import TextShow.Utils (isTupleString) #endif #if !(MIN_VERSION_base(4,10,0))-# if MIN_VERSION_base(4,9,0) tyConOf :: Typeable a => Proxy a -> TyCon tyConOf = typeRepTyCon . typeRep @@ -95,21 +91,67 @@ tc'Unlifted :: TyCon tc'Unlifted = tyConOf (Proxy :: Proxy 'PtrRepUnlifted)-# else--- | The list 'TyCon'.-tcList :: TyCon-tcList = listTc---- | The function (@->@) 'TyCon'.-tcFun :: TyCon-tcFun = funTc-# endif #endif -- | Does the 'TyCon' represent a tuple type constructor?+#if MIN_VERSION_base(4,20,0)+isTupleTyCon :: TyCon -> Maybe (Bool, Int)+isTupleTyCon tc+# if MIN_VERSION_base(4,22,0)+ | tyConPackage tc == "ghc-internal"+ , tyConModule tc == "GHC.Internal.Tuple" || tyConModule tc == "GHC.Internal.Types"+# else+ | tyConPackage tc == "ghc-prim"+ , tyConModule tc == "GHC.Tuple" || tyConModule tc == "GHC.Types"+# endif+ = case tyConName tc of+ "Unit" -> Just (True, 0)+ "Unit#" -> Just (False, 0)+ 'T' : 'u' : 'p' : 'l' : 'e' : arity -> readTwoDigits arity+ _ -> Nothing+ | otherwise = Nothing++readTwoDigits :: String -> Maybe (Bool, Int)+readTwoDigits s = case s of+ c1 : t1 | isDigit c1 -> case t1 of+ [] -> Just (True, digit_to_int c1)+ ['#'] -> Just (False, digit_to_int c1)+ c2 : t2 | isDigit c2 ->+ let ar = digit_to_int c1 * 10 + digit_to_int c2+ in case t2 of+ [] -> Just (True, ar)+ ['#'] -> Just (False, ar)+ _ -> Nothing+ _ -> Nothing+ _ -> Nothing+ where+ digit_to_int :: Char -> Int+ digit_to_int c = ord c - ord '0'+#elif MIN_VERSION_base(4,19,0)+isTupleTyCon :: TyCon -> Maybe Int+isTupleTyCon tc+ | tyConPackage tc == "ghc-prim"+ , tyConModule tc == "GHC.Tuple.Prim"+ = case tyConName tc of+ "Unit" -> Just 0+ 'T' : 'u' : 'p' : 'l' : 'e' : arity -> readTwoDigits arity+ _ -> Nothing+ | otherwise = Nothing++readTwoDigits :: String -> Maybe Int+readTwoDigits s = case s of+ [c] | isDigit c -> Just (digit_to_int c)+ [c1, c2] | isDigit c1, isDigit c2+ -> Just (digit_to_int c1 * 10 + digit_to_int c2)+ _ -> Nothing+ where+ digit_to_int :: Char -> Int+ digit_to_int c = ord c - ord '0'+#else isTupleTyCon :: TyCon -> Bool isTupleTyCon = isTupleString . tyConName {-# INLINE isTupleTyCon #-}+#endif #if MIN_VERSION_base(4,10,0) -- | Only available with @base-4.10.0.0@ or later.@@ -134,11 +176,50 @@ showbTypeable _ rep | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = singleton '*'+ | isListTyCon tc, [] <- tys =+ fromString "[]" | isListTyCon tc, [ty] <- tys = singleton '[' <> showb ty <> singleton ']'- | isTupleTyCon tc =+# if MIN_VERSION_base(4,20,0)+ | Just (boxed, n) <- isTupleTyCon tc,+ Just sat <- plainOrSaturated boxed n =+ tuple n boxed sat+# elif MIN_VERSION_base(4,19,0)+ | Just _ <- isTupleTyCon tc,+ Just _ <- typeRep @Type `eqTypeRep` typeRepKind rep = showbTuple tys- where (tc, tys) = splitApps rep+ -- Print (,,,) instead of Tuple4+ | Just n <- isTupleTyCon tc, [] <- tys =+ singleton '(' <> fromString (replicate (n-1) ',') <> singleton ')'+# else+ | isTupleTyCon tc+# if MIN_VERSION_base(4,13,0)+ , Just _ <- typeRep @Type `eqTypeRep` typeRepKind rep+# endif+ = showbTuple tys+# endif+ where+ (tc, tys) = splitApps rep++# if MIN_VERSION_base(4,20,0)+ plainOrSaturated True _ | Just _ <- typeRep @Type `eqTypeRep` typeRepKind rep = Just True+ plainOrSaturated False n | n == length tys = Just True+ plainOrSaturated _ _ | [] <- tys = Just False+ plainOrSaturated _ _ | otherwise = Nothing++ tuple n boxed sat =+ let+ (lpar, rpar) = case boxed of+ True -> ("(", ")")+ False -> ("(#", "#)")+ commas = fromString (replicate (n-1) ',')+ args = showbArgs (fromString ",") tys+ args' = case (boxed, sat) of+ (True, True) -> args+ (False, True) -> singleton ' ' <> args <> singleton ' '+ (_, False) -> commas+ in fromString lpar <> args' <> fromString rpar+# endif showbTypeable p (Con' tycon []) = showbPrec p tycon showbTypeable p (Con' tycon args)@@ -159,11 +240,11 @@ splitApps = go [] where go :: [SomeTypeRep] -> TypeRep a -> (TyCon, [SomeTypeRep])- go xs (Con tc) = (tc, xs)- go xs (App f x) = go (SomeTypeRep x : xs) f go [] (Fun a b) = (funTyCon, [SomeTypeRep a, SomeTypeRep b]) go _ (Fun _ _) = errorWithoutStackTrace "Data.Typeable.Internal.splitApps: Impossible"+ go xs (Con tc) = (tc, xs)+ go xs (App f x) = go (SomeTypeRep x : xs) f funTyCon :: TyCon funTyCon = typeRepTyCon (typeRep @(->))@@ -171,23 +252,17 @@ isListTyCon :: TyCon -> Bool isListTyCon tc = tc == typeRepTyCon (typeRep :: TypeRep [Int]) #else--- | Only available with @base-4.9@ or earlier.+-- | Only available with @base-4.9@. -- -- /Since: 2/ instance TextShow TypeRep where showbPrec p tyrep = case tys of [] -> showb tycon-# if MIN_VERSION_base(4,9,0) [x@(TypeRep _ argCon _ _)]-# else- [x]-# endif | tycon == tcList -> singleton '[' <> showb x <> singleton ']'-# if MIN_VERSION_base(4,9,0) | tycon == tcTYPE && argCon == tc'Lifted -> singleton '*' | tycon == tcTYPE && argCon == tc'Unlifted -> singleton '#'-# endif [a,r] | tycon == tcFun -> showbParen (p > 8) $ showbPrec 9 a <> " -> "@@ -196,34 +271,22 @@ | otherwise -> showbParen (p > 9) $ showbPrec p tycon <> showbSpace- <> showbArgs showbSpace-# if MIN_VERSION_base(4,8,0)- (kinds ++ tys)-# else- tys-# endif+ <> showbArgs showbSpace (kinds ++ tys) where tycon = typeRepTyCon tyrep tys = typeRepArgs tyrep-# if MIN_VERSION_base(4,8,0) kinds = typeRepKinds tyrep-# endif #endif -- | /Since: 2/ instance TextShow TyCon where #if MIN_VERSION_base(4,10,0) showbPrec p (TyCon _ _ _ tc_name _ _) = showbPrec p tc_name-#elif MIN_VERSION_base(4,9,0)- showb (TyCon _ _ _ tc_name) = showb tc_name #else- showb = fromString . tyConName+ showb (TyCon _ _ _ tc_name) = showb tc_name #endif -#if MIN_VERSION_base(4,9,0)--- | Only available with @base-4.9.0.0@ or later.------ /Since: 3/+-- | /Since: 3/ instance TextShow TrName where showb (TrNameS s) = unpackCStringToBuilder# s showb (TrNameD s) = fromString s@@ -243,10 +306,7 @@ !ch = indexCharOffAddr# addr nh {-# NOINLINE unpackCStringToBuilder# #-} --- | Only available with @base-4.9.0.0@ or later.------ /Since: 3/+-- | /Since: 3/ instance TextShow Module where showb (Module p m) = showb p <> singleton ':' <> showb m {-# INLINE showb #-}-#endif
src/TextShow/Data/Typeable/Utils.hs view
@@ -6,7 +6,7 @@ Stability: Provisional Portability: GHC -Utility functions for showing data types in the @Typeable@ (or @OldTypeable@) module.+Utility functions for showing data types in the @Typeable@ module. -} module TextShow.Data.Typeable.Utils (showbArgs, showbTuple) where
src/TextShow/Data/Version.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Version Copyright: (C) 2014-2017 Ryan Scott
src/TextShow/Data/Void.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Void Copyright: (C) 2014-2017 Ryan Scott@@ -13,7 +13,7 @@ -} module TextShow.Data.Void () where -import Data.Void.Compat (Void, absurd)+import Data.Void (Void, absurd) import Prelude () import TextShow.Classes (TextShow(..))
src/TextShow/Debug/Trace.hs view
@@ -45,14 +45,13 @@ , tracetlEvent , tracetEventIO , tracetlEventIO-#if MIN_VERSION_base(4,7,0)+ -- * Execution phase markers -- $markers , tracetMarker , tracetlMarker , tracetMarkerIO , tracetlMarkerIO-#endif ) where import Control.Monad (unless)@@ -299,7 +298,6 @@ tracetlEventIO :: TL.Text -> IO () tracetlEventIO = traceEventIO . TL.unpack -#if MIN_VERSION_base(4,7,0) -- $markers -- -- When looking at a profile for the execution of a program we often want to@@ -356,4 +354,3 @@ -- /Since: 2/ tracetlMarkerIO :: TL.Text -> IO () tracetlMarkerIO = traceMarkerIO . TL.unpack-#endif
src/TextShow/Debug/Trace/Generic.hs view
@@ -19,28 +19,28 @@ , genericTraceTextShowM ) where -import Generics.Deriving.Base (Generic, Rep)+import GHC.Generics (Generic, Rep) import Prelude () import Prelude.Compat import TextShow.Debug.Trace-import TextShow.Generic (GTextShowT, Zero, genericShowt)+import TextShow.Generic (GTextShowT, genericShowt) -- | A 'Generic' implementation of 'traceTextShow'. -- -- /Since: 2/-genericTraceTextShow :: (Generic a, GTextShowT Zero (Rep a)) => a -> b -> b+genericTraceTextShow :: (Generic a, GTextShowT (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 :: (Generic a, GTextShowT (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 :: (Generic a, GTextShowT (Rep a ()), Applicative f) => a -> f () genericTraceTextShowM = tracetM . genericShowt
src/TextShow/Foreign/C/Types.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Foreign.C.Types
src/TextShow/Foreign/Ptr.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Foreign.Ptr Copyright: (C) 2014-2017 Ryan Scott@@ -16,7 +16,7 @@ -} module TextShow.Foreign.Ptr () where -import Data.Semigroup.Compat (mtimesDefault)+import Data.Semigroup (mtimesDefault) import Data.Text.Lazy.Builder (Builder, singleton) import Foreign.ForeignPtr (ForeignPtr)
src/TextShow/FromStringTextShow.hs view
@@ -1,27 +1,18 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveLift #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-}+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-} -#if __GLASGOW_HASKELL__ >= 706-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE PolyKinds #-}-#endif--#if __GLASGOW_HASKELL__ >= 800-{-# LANGUAGE DeriveLift #-}-#endif--{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -Wno-name-shadowing #-} {-| Module: TextShow.FromStringTextShow@@ -42,22 +33,16 @@ , 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+import Data.Coerce (coerce)+import Data.Data (Data)+import Data.Functor.Classes (Show1(..), Show2(..),+ showsPrec1, showsPrec2) -#if __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic, Generic1)-#endif -import Language.Haskell.TH.Lift+import Language.Haskell.TH.Syntax (Lift) import Prelude () import Prelude.Compat@@ -69,14 +54,7 @@ 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- ------------------------------------------------------------------------------- -- | An adapter newtype, suitable for @DerivingVia@.@@ -93,16 +71,11 @@ , 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@@ -121,26 +94,6 @@ 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- ------------------------------------------------------------------------------- -- | An adapter newtype, suitable for @DerivingVia@.@@ -157,17 +110,12 @@ , 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@@ -181,27 +129,6 @@ 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- ------------------------------------------------------------------------------- -- | An adapter newtype, suitable for @DerivingVia@.@@ -218,53 +145,32 @@ -- /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+ , Generic+ , Generic1 , Lift+ , Ord , 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)+-- | This instance is somewhat strange, as its instance context mixes a+-- 'Show1' constraint with a 'TextShow' constraint. This is done for+-- consistency with the 'Show' instance for 'FromTextShow1', which mixes+-- constraints in a similar way to satisfy superclass constraints. See the+-- Haddocks on the 'Show' instance for 'FromTextShow1' for more details.+instance (Show1 f, TextShow a) => TextShow (FromStringShow1 f a) where+ showbPrec = showbPrec1 --- | Not available if using @transformers-0.4@ instance Show1 f => TextShow1 (FromStringShow1 f) where liftShowbPrec sp sl p = showsPrecToShowbPrec (liftShowsPrec (showbPrecToShowsPrec sp)@@ -277,7 +183,6 @@ where coerceList :: [FromStringShow1 f a] -> [f a] coerceList = coerce-#endif instance (Show1 f, Show a) => Show (FromStringShow1 f a) where showsPrec = showsPrec1@@ -299,53 +204,37 @@ -- /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+ , Generic+ , Generic1 , Lift+ , Ord , 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+-- | This instance is somewhat strange, as its instance context mixes a+-- 'TextShow1' constraint with a 'Show' constraint. The 'Show' constraint is+-- necessary to satisfy the quantified 'Show' superclass in 'Show1'. Really,+-- the 'Show' constraint ought to be a 'TextShow' constraint instead, but GHC+-- has no way of knowing that the 'TextShow' constraint can be converted to a+-- 'Show' constraint when checking superclasses.+--+-- This is all to say: this instance is almost surely not what you want if you+-- are looking to derive a 'Show' instance only via 'TextShow'-related+-- classes. If you wish to do this, derive via 'FromTextShow' instead.+instance (TextShow1 f, Show a) => Show (FromTextShow1 f a) where+ showsPrec = showsPrec1 instance TextShow1 f => Show1 (FromTextShow1 f) where-#if defined(NEW_FUNCTOR_CLASSES) liftShowList sp sl = showbToShows (liftShowbList (showsPrecToShowbPrec sp) (showsToShowb sl))@@ -353,11 +242,8 @@ where coerceList :: [FromTextShow1 f a] -> [f a] coerceList = coerce- liftShowsPrec sp sl p-#else- showsPrec1 p-#endif- = showbPrecToShowsPrec (liftShowbPrec (showsPrecToShowbPrec sp)+ liftShowsPrec sp sl p =+ showbPrecToShowsPrec (liftShowbPrec (showsPrecToShowbPrec sp) (showsToShowb sl)) p . fromTextShow1 @@ -383,60 +269,42 @@ -- /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+ , Generic+ , Generic1 , Lift+ , Ord , 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)+-- | This instance is somewhat strange, as its instance context mixes a+-- 'Show2' constraint with 'TextShow' constraints. This is done for consistency+-- with the 'Show' instance for 'FromTextShow2', which mixes constraints in a+-- similar way to satisfy superclass constraints. See the Haddocks on the+-- 'Show' instance for 'FromTextShow2' for more details.+instance (Show2 f, TextShow a, TextShow b) => TextShow (FromStringShow2 f a b) where+ showbPrec = showbPrec2 --- | Not available if using @transformers-0.4@-instance (Show2 f, Show a) => TextShow1 (FromStringShow2 f a) where- liftShowbPrec = liftShowbPrec2 (showsPrecToShowbPrec showsPrec)- (showsToShowb showList)- liftShowbList = liftShowbList2 (showsPrecToShowbPrec showsPrec)- (showsToShowb showList)+-- | This instance is somewhat strange, as its instance context mixes a+-- 'Show2' constraint with a 'TextShow' constraint. This is done for+-- consistency with the 'Show1' instance for 'FromTextShow2', which mixes+-- constraints in a similar way to satisfy superclass constraints. See the+-- Haddocks on the 'Show1' instance for 'FromTextShow2' for more details.+instance (Show2 f, TextShow a) => TextShow1 (FromStringShow2 f a) where+ liftShowbPrec = liftShowbPrec2 showbPrec showbList+ liftShowbList = liftShowbList2 showbPrec showbList --- | Not available if using @transformers-0.4@ instance Show2 f => TextShow2 (FromStringShow2 f) where liftShowbPrec2 sp1 sl1 sp2 sl2 p = showsPrecToShowbPrec (liftShowsPrec2 (showbPrecToShowsPrec sp1)@@ -454,16 +322,13 @@ 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 ------------------------------------------------------------------------------- @@ -483,58 +348,50 @@ -- /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+ , Ord , Foldable , Functor+ , Generic+ , Generic1 , 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)+-- | This instance is somewhat strange, as its instance context mixes a+-- 'TextShow2' constraint with 'Show' constraints. The 'Show' constraints are+-- necessary to satisfy the quantified 'Show' superclass in 'Show2'. Really,+-- the 'Show' constraints ought to be 'TextShow' constraints instead, but GHC+-- has no way of knowing that the 'TextShow' constraints can be converted to+-- 'Show' constraints when checking superclasses.+--+-- This is all to say: this instance is almost surely not what you want if you+-- are looking to derive a 'Show' instance only via 'TextShow'-related+-- classes. If you wish to do this, derive via 'FromTextShow' instead.+instance (TextShow2 f, Show a, Show b) => Show (FromTextShow2 f a b) where+ showsPrec = showsPrec2 --- | Not available if using @transformers-0.4@-instance (TextShow2 f, TextShow a) => Show1 (FromTextShow2 f a) where- liftShowsPrec = liftShowsPrec2 (showbPrecToShowsPrec showbPrec)- (showbToShows showbList)- liftShowList = liftShowList2 (showbPrecToShowsPrec showbPrec)- (showbToShows showbList)+-- | This instance is somewhat strange, as its instance context mixes a+-- 'TextShow2' constraint with a 'Show' constraint. The 'Show' constraint is+-- necessary to satisfy the quantified 'Show' superclass in 'Show2'. Really,+-- the 'Show' constraint ought to be a 'TextShow' constraint instead, but GHC+-- has no way of knowing that the 'TextShow' constraint can be converted to a+-- 'Show' constraint when checking superclasses.+--+-- This is all to say: this instance is almost surely not what you want if you+-- are looking to derive a 'Show1' instance only via 'TextShow'-related+-- classes. If you wish to do this, derive via 'FromTextShow1' instead.+instance (TextShow2 f, Show a) => Show1 (FromTextShow2 f a) where+ liftShowsPrec = liftShowsPrec2 showsPrec showList+ liftShowList = liftShowList2 showsPrec showList --- | Not available if using @transformers-0.4@ instance TextShow2 f => Show2 (FromTextShow2 f) where liftShowsPrec2 sp1 sl1 sp2 sl2 p = showbPrecToShowsPrec (liftShowbPrec2 (showsPrecToShowbPrec sp1)@@ -551,7 +408,6 @@ 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@@ -563,62 +419,9 @@ ------------------------------------------------------------------------------- -#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
src/TextShow/Functions.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Functions Copyright: (C) 2014-2017 Ryan Scott
src/TextShow/GHC/Conc/Windows.hs view
@@ -1,8 +1,8 @@ {-# LANGUAGE CPP #-} -#if !defined(__GHCJS__) && defined(mingw32_HOST_OS)+#if !defined(__GHCJS__) && !defined(ghcjs_HOST_OS) && defined(mingw32_HOST_OS) {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} #endif {-| Module: TextShow.GHC.Conc.Windows@@ -19,7 +19,7 @@ -} module TextShow.GHC.Conc.Windows () where -#if !defined(__GHCJS__) && defined(mingw32_HOST_OS)+#if !defined(__GHCJS__) && !defined(ghcjs_HOST_OS) && defined(mingw32_HOST_OS) import GHC.Conc.Windows (ConsoleEvent) import TextShow.TH.Internal (deriveTextShow)
src/TextShow/GHC/Event.hs view
@@ -1,9 +1,9 @@ {-# LANGUAGE CPP #-} -#if !defined(__GHCJS__) && !defined(mingw32_HOST_OS)+#if !defined(__GHCJS__) && !defined(ghcjs_HOST_OS) && !defined(mingw32_HOST_OS) {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} #endif {-| Module: TextShow.GHC.Event@@ -20,12 +20,12 @@ -} module TextShow.GHC.Event () where -#if !defined(__GHCJS__) && !defined(mingw32_HOST_OS)+#if !defined(__GHCJS__) && !defined(ghcjs_HOST_OS) && !defined(mingw32_HOST_OS) import Data.List (intersperse) import Data.Maybe (catMaybes) import Data.Text.Lazy.Builder (Builder, singleton) -import GHC.Event (Event, evtRead, evtWrite)+import GHC.Event (Event, Lifetime, evtRead, evtWrite) import Language.Haskell.TH.Lib (conT, varE) @@ -39,10 +39,6 @@ import TextShow.TH.Names (evtCloseValName, eventIsValName, fdKeyTypeName, uniqueTypeName, asInt64ValName) -# if MIN_VERSION_base(4,8,1)-import GHC.Event (Lifetime)-# endif- -- | /Since: 2/ instance TextShow Event where showb e = singleton '[' <> mconcat (intersperse "," $ catMaybes@@ -62,10 +58,6 @@ showb = showb . $(varE asInt64ValName) {-# INLINE showb #-} -# if MIN_VERSION_base(4,8,1)--- | Only available with @base-4.8.1.0@ or later.------ /Since: 2/+-- | /Since: 2/ $(deriveTextShow ''Lifetime)-# endif #endif
src/TextShow/GHC/Fingerprint.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.GHC.Fingerprint Copyright: (C) 2014-2017 Ryan Scott@@ -14,7 +14,7 @@ -} module TextShow.GHC.Fingerprint () where -import Data.Semigroup.Compat (mtimesDefault)+import Data.Semigroup (mtimesDefault) import Data.Text.Lazy.Builder (Builder, singleton) import Data.Word (Word64)
src/TextShow/GHC/Generics.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE KindSignatures #-}@@ -7,7 +6,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.GHC.Generics@@ -23,7 +22,7 @@ -} module TextShow.GHC.Generics () where -import Generics.Deriving.Base+import GHC.Generics import TextShow.Classes (TextShow(..), TextShow1(..), TextShow2(..)) import TextShow.Data.Char ()@@ -118,22 +117,9 @@ $(deriveTextShow ''Associativity) -- | /Since: 2/ $(deriveTextShow ''Fixity)-#if MIN_VERSION_base(4,9,0)--- | Only available with @base-4.9.0.0@ or later.------ /Since: 3/+-- | /Since: 3/ $(deriveTextShow ''SourceUnpackedness)--- | Only available with @base-4.9.0.0@ or later.------ /Since: 3/+-- | /Since: 3/ $(deriveTextShow ''SourceStrictness)--- | Only available with @base-4.9.0.0@ or later.------ /Since: 3/+-- | /Since: 3/ $(deriveTextShow ''DecidedStrictness)-#else--- | Only available with @base-4.8@ or earlier.------ /Since: 2/-$(deriveTextShow ''Arity)-#endif
src/TextShow/GHC/RTS/Flags.hs view
@@ -1,9 +1,6 @@ {-# LANGUAGE CPP #-}--#if MIN_VERSION_base(4,8,0) {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-#endif+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.GHC.RTS.Flags Copyright: (C) 2014-2017 Ryan Scott@@ -13,14 +10,17 @@ Portability: GHC 'TextShow' instances for data types in the 'GHC.RTS.Flags' module.-Only provided if using @base-4.8.0.0@ or later. /Since: 2/ -} module TextShow.GHC.RTS.Flags () where -#if MIN_VERSION_base(4,8,0) import GHC.RTS.Flags+#if MIN_VERSION_base(4,21,0)+import qualified GHC.IO.SubSystem as SubSystem+#elif MIN_VERSION_base(4,15,0)+import qualified GHC.RTS.Flags as SubSystem+#endif import TextShow.Data.Bool () import TextShow.Data.Char ()@@ -45,10 +45,14 @@ $(deriveTextShow ''GCFlags) -- | /Since: 2/ $(deriveTextShow ''ConcFlags)-# if MIN_VERSION_base(4,15,0)+#if MIN_VERSION_base(4,15,0) -- | /Since: 3.9/-$(deriveTextShow ''IoSubSystem)-# endif+$(deriveTextShow ''SubSystem.IoSubSystem)+#endif+#if MIN_VERSION_base(4,21,0)+-- | /Since: 3.11/+$(deriveTextShow ''IoManagerFlag)+#endif -- | /Since: 2/ $(deriveTextShow ''MiscFlags) -- | /Since: 2/@@ -61,12 +65,17 @@ $(deriveTextShow ''TraceFlags) -- | /Since: 2/ $(deriveTextShow ''TickyFlags)-# if MIN_VERSION_base(4,10,0)+#if MIN_VERSION_base(4,10,0) -- | Only available with @base-4.10.0.0@ or later. -- -- /Since: 3.3/ $(deriveTextShow ''ParFlags)-# endif+#endif+#if MIN_VERSION_base(4,20,0)+-- | Only available with @base-4.20.0.0@ or later.+--+-- /Since: 3.10.5/+$(deriveTextShow ''HpcFlags)+#endif -- | /Since: 2/ $(deriveTextShow ''RTSFlags)-#endif
src/TextShow/GHC/Stack.hs view
@@ -1,9 +1,6 @@ {-# LANGUAGE CPP #-}--#if MIN_VERSION_base(4,8,1) {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-#endif+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.GHC.Stack Copyright: (C) 2014-2017 Ryan Scott@@ -13,21 +10,14 @@ Portability: GHC 'TextShow' instances for 'CallStack' and 'SrcLoc' values.-Only provided if using @base-4.8.1.0@ or later. /Since: 3.0.1/ -} module TextShow.GHC.Stack () where -#if MIN_VERSION_base(4,8,1)-import GHC.Stack (CallStack)-# if MIN_VERSION_base(4,9,0)-import GHC.Stack (SrcLoc, getCallStack)-import TextShow.Classes (TextShow(..))-# else-import GHC.SrcLoc (SrcLoc)-# endif+import GHC.Stack (CallStack, SrcLoc, getCallStack) +import TextShow.Classes (TextShow(..)) import TextShow.Data.Char () import TextShow.Data.Integral () import TextShow.Data.List ()@@ -37,13 +27,7 @@ -- | /Since: 3.0.1/ $(deriveTextShow ''SrcLoc) -# if MIN_VERSION_base(4,9,0) -- | /Since: 3.0.1/ instance TextShow CallStack where showb = showb . getCallStack {-# INLINE showb #-}-# else--- | /Since: 3.0.1/-$(deriveTextShow ''CallStack)-# endif-#endif
src/TextShow/GHC/StaticPtr.hs view
@@ -1,9 +1,5 @@-{-# LANGUAGE CPP #-}--#if MIN_VERSION_base(4,8,0) {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-#endif+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.GHC.StaticPtr Copyright: (C) 2014-2017 Ryan Scott@@ -13,13 +9,11 @@ Portability: GHC 'TextShow' instance for 'StaticPtrInfo'.-Only provided if using @base-4.8.0.0@ or later. /Since: 2/ -} module TextShow.GHC.StaticPtr () where -#if MIN_VERSION_base(4,8,0) import GHC.StaticPtr (StaticPtrInfo) import TextShow.Data.Char ()@@ -30,4 +24,3 @@ -- | /Since: 2/ $(deriveTextShow ''StaticPtrInfo)-#endif
src/TextShow/GHC/Stats.hs view
@@ -2,8 +2,12 @@ #if !(MIN_VERSION_base(4,11,0)) {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-deprecations #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-deprecations #-}+{-# OPTIONS_GHC -Wno-orphans #-}+# if __GLASGOW_HASKELL__ == 800+-- See Note [Increased simpl-tick-factor on old GHCs] in TextShow.Data.Complex+{-# OPTIONS_GHC -fsimpl-tick-factor=200 #-}+# endif #endif {-|
src/TextShow/GHC/TypeLits.hs view
@@ -1,17 +1,5 @@-{-# 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+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.GHC.TypeLits Copyright: (C) 2014-2017 Ryan Scott@@ -21,65 +9,71 @@ Portability: GHC 'TextShow' instances for data types in the @GHC.TypeLits@ module.-Only provided if using @base-4.6.0.0@ or later. /Since: 2/ -} module TextShow.GHC.TypeLits () where -#if MIN_VERSION_base(4,6,0)+import GHC.TypeLits (SomeNat(..), SomeSymbol(..), natVal, symbolVal)+#if MIN_VERSION_base(4,16,0)+import GHC.TypeLits (SomeChar(..), charVal)+#endif+ import Prelude () import Prelude.Compat import TextShow.Classes (TextShow(..))+import TextShow.Data.Char () import TextShow.Data.Integral () -# if MIN_VERSION_base(4,7,0)-import GHC.TypeLits (SomeNat(..), SomeSymbol(..), natVal, symbolVal)-import TextShow.Data.Char ()-# else-import Data.Text.Lazy.Builder (singleton)-import GHC.TypeLits (IsEven(..), IsZero(..), Kind, Sing, SingE(fromSing))-# endif+#if MIN_VERSION_base(4,18,0)+import Data.Text.Lazy.Builder (fromString)+import GHC.Show (appPrec, appPrec1)+import GHC.TypeLits ( SNat, SSymbol, SChar+ , fromSNat, fromSSymbol, fromSChar+ )+import TextShow.Classes (showbParen)+#endif -# if MIN_VERSION_base(4,7,0)--- | Only available with @base-4.7.0.0@ or later.------ /Since: 2/+-- | /Since: 2/ instance TextShow SomeNat where showbPrec p (SomeNat x) = showbPrec p $ natVal x {-# INLINE showbPrec #-} --- | Only available with @base-4.7.0.0@ or later.------ /Since: 2/+-- | /Since: 2/ instance TextShow SomeSymbol where showb (SomeSymbol x) = showbList $ symbolVal x {-# INLINE showb #-}-# else--- | Only available with @base-4.6@.------ /Since: 2/-instance TextShow (IsEven n) where- showb IsEvenZero = singleton '0'- showb (IsEven x) = "(2 * " <> showb x <> singleton ')'- showb (IsOdd x) = "(2 * " <> showb x <> " + 1)"- {-# INLINE showb #-} --- | Only available with @base-4.6@.------ /Since: 2/-instance TextShow (IsZero n) where- showb IsZero = singleton '0'- showb (IsSucc n) = singleton '(' <> showb n <> " + 1)"- {-# INLINE showb #-}---- | Only available with @base-4.6@.------ /Since: 2/-instance (SingE (Kind :: k) rep, TextShow rep) => TextShow (Sing (a :: k)) where- showbPrec p = showbPrec p . fromSing+#if MIN_VERSION_base(4,16,0)+-- | /Since: 3.10.1/+instance TextShow SomeChar where+ showbPrec p (SomeChar x) = showbPrec p $ charVal x {-# INLINE showbPrec #-}-# endif+#endif +#if MIN_VERSION_base(4,18,0)+-- | /Since: 3.10.1/+instance TextShow (SNat n) where+ showbPrec p sn+ = showbParen (p > appPrec)+ ( fromString "SNat @"+ <> showbPrec appPrec1 (fromSNat sn)+ )++-- | /Since: 3.10.1/+instance TextShow (SSymbol s) where+ showbPrec p ss+ = showbParen (p > appPrec)+ ( fromString "SSymbol @"+ <> showbList (fromSSymbol ss)+ )++-- | /Since: 3.10.1/+instance TextShow (SChar c) where+ showbPrec p sc+ = showbParen (p > appPrec)+ ( fromString "SChar @"+ <> showbPrec appPrec1 (fromSChar sc)+ ) #endif
src/TextShow/Generic.hs view
@@ -1,10 +1,13 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveLift #-} {-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE EmptyCase #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}@@ -12,6 +15,7 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeOperators #-}@@ -20,17 +24,8 @@ {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-} -#if __GLASGOW_HASKELL__ >= 706-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE PolyKinds #-}-#endif--#if __GLASGOW_HASKELL__ >= 708-{-# LANGUAGE EmptyCase #-}-#endif--#if __GLASGOW_HASKELL__ >= 800-{-# LANGUAGE DeriveLift #-}+#if __GLASGOW_HASKELL__ >= 806+{-# LANGUAGE QuantifiedConstraints #-} #endif {-|@@ -57,9 +52,6 @@ -- * Generic @show@ functions -- $generics-- -- ** Understanding a compiler error- -- $generic_err , genericShowt , genericShowtl , genericShowtPrec@@ -79,24 +71,24 @@ -- ** 'Builder' , GTextShowB(..) , GTextShowConB(..)- , ShowFunsB(..)+ , GTextShowB1(..)+ , GTextShowConB1(..) -- ** Strict 'TS.Text' , GTextShowT(..) , GTextShowConT(..)- , ShowFunsT(..)+ , GTextShowT1(..)+ , GTextShowConT1(..) -- ** Lazy 'TL.Text' , GTextShowTL(..) , GTextShowConTL(..)- , ShowFunsTL(..)+ , GTextShowTL1(..)+ , GTextShowConTL1(..) -- ** Other internals , IsNullary(..) , ConType(..)- , Zero- , One ) where import Data.Data (Data, Typeable)-import Data.Functor.Contravariant.Compat (Contravariant(..)) 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)@@ -104,15 +96,12 @@ import qualified Data.Text.Lazy.Builder as TB (fromString, singleton) import Data.Text.Lazy.Builder (Builder) -import Generics.Deriving.Base-#if !defined(__LANGUAGE_DERIVE_GENERIC1__)-import qualified Generics.Deriving.TH as Generics-#endif+import GHC.Generics import GHC.Exts (Char(C#), Double(D#), Float(F#), Int(I#), Word(W#)) import GHC.Show (appPrec, appPrec1) -import Language.Haskell.TH.Lift+import Language.Haskell.TH.Syntax (Lift) import Prelude () import Prelude.Compat@@ -158,30 +147,6 @@ @ -} -{- $generic_err--Suppose you intend to define a 'TextShow' instance via 'FromGeneric':--@-data Oops = Oops- deriving 'TextShow' via 'FromGeneric' Oops- -- forgot to add \"deriving Generic\" here!-@--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.--}- -- | An adapter newtype, suitable for @DerivingVia@. -- The 'TextShow' instance for 'FromGeneric' leverages a 'Generic'-based -- default. That is,@@ -196,22 +161,17 @@ , Eq , Foldable , Functor+ , Generic+ , Generic1 , Ord , Read , Show , Traversable- , Typeable-#if __GLASGOW_HASKELL__ >= 706- , Generic- , Generic1-#endif-#if __GLASGOW_HASKELL__ >= 800 , Lift-#endif ) -- | /Since: 3.7.4/-instance (Generic a, GTextShowB Zero (Rep a)) => TextShow (FromGeneric a) where+instance (Generic a, GTextShowB (Rep a ())) => TextShow (FromGeneric a) where showbPrec p = genericShowbPrec p . fromGeneric -- | An adapter newtype, suitable for @DerivingVia@.@@ -228,127 +188,137 @@ , Ord , Read , Show-#if __GLASGOW_HASKELL__ >= 706 , Generic-#endif-#if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1-#endif-#if __GLASGOW_HASKELL__ >= 800 , Lift-#endif ) deriving instance Foldable f => Foldable (FromGeneric1 f) deriving instance Functor f => Functor (FromGeneric1 f) deriving instance Traversable f => Traversable (FromGeneric1 f)--#if __GLASGOW_HASKELL__ >= 708-deriving instance Typeable FromGeneric1 deriving instance ( Data (f a), Typeable f, Typeable a ) => Data (FromGeneric1 f (a :: *))-#endif +-- | /Since: 3.10/+instance (Generic1 f, GTextShowB (Rep1 f a)) => TextShow (FromGeneric1 f a) where+ showbPrec p = gShowbPrec p . from1 . fromGeneric1+ -- | /Since: 3.7.4/-instance (Generic1 f, GTextShowB One (Rep1 f)) => TextShow1 (FromGeneric1 f) where+instance ( Generic1 f+#if __GLASGOW_HASKELL__ >= 806 && __GLASGOW_HASKELL__ < 902+ -- Unfortunately, the quantified superclass for GTextShowB1 doesn't+ -- work on pre-9.2 versions of GHC when using a GTextShowB1 (Rep1 f)+ -- constraint directly, perhaps due to+ -- https://gitlab.haskell.org/ghc/ghc/-/issues/14860#note_454218.+ -- Fortunately, we can make GHC come to its senses by using an+ -- equality constraint.+ , g ~ Rep1 f, GTextShowB1 g+#else+ , GTextShowB1 (Rep1 f)+#endif+ ) => TextShow1 (FromGeneric1 f) where liftShowbPrec sp sl p = genericLiftShowbPrec sp sl p . fromGeneric1 -- | A 'Generic' implementation of 'showt'. -- -- /Since: 2/-genericShowt :: (Generic a, GTextShowT Zero (Rep a)) => a -> TS.Text+genericShowt :: (Generic a, GTextShowT (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 :: (Generic a, GTextShowTL (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+genericShowtPrec :: (Generic a, GTextShowT (Rep a ())) => Int -> a -> TS.Text+genericShowtPrec p = gShowtPrec p . fromRepUnit -- | A 'Generic' implementation of 'showtlPrec'. -- -- /Since: 2/-genericShowtlPrec :: (Generic a, GTextShowTL Zero (Rep a)) => Int -> a -> TL.Text-genericShowtlPrec p = gShowtlPrec NoShowFunsTL p . from+genericShowtlPrec :: (Generic a, GTextShowTL (Rep a ())) => Int -> a -> TL.Text+genericShowtlPrec p = gShowtlPrec p . fromRepUnit -- | A 'Generic' implementation of 'showtList'. -- -- /Since: 2/-genericShowtList :: (Generic a, GTextShowT Zero (Rep a)) => [a] -> TS.Text+genericShowtList :: (Generic a, GTextShowT (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 :: (Generic a, GTextShowTL (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 :: (Generic a, GTextShowB (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+genericShowbPrec :: (Generic a, GTextShowB (Rep a ())) => Int -> a -> Builder+genericShowbPrec p = gShowbPrec p . fromRepUnit -- | A 'Generic' implementation of 'showbList'. -- -- /Since: 2/-genericShowbList :: (Generic a, GTextShowB Zero (Rep a)) => [a] -> Builder+genericShowbList :: (Generic a, GTextShowB (Rep a ())) => [a] -> Builder genericShowbList = showbListWith genericShowb -- | A 'Generic' implementation of 'printT'. -- -- /Since: 2/-genericPrintT :: (Generic a, GTextShowT Zero (Rep a)) => a -> IO ()+genericPrintT :: (Generic a, GTextShowT (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 :: (Generic a, GTextShowTL (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 :: (Generic a, GTextShowT (Rep a ())) => Handle -> a -> IO () genericHPrintT h = TS.hPutStrLn h . genericShowt -- | A 'Generic' implementation of 'hPrintTL'. -- -- /Since: 2/-genericHPrintTL :: (Generic a, GTextShowTL Zero (Rep a)) => Handle -> a -> IO ()+genericHPrintTL :: (Generic a, GTextShowTL (Rep a ())) => Handle -> a -> IO () genericHPrintTL h = TL.hPutStrLn h . genericShowtl -- | A 'Generic1' implementation of 'genericLiftShowbPrec'. -- -- /Since: 2/-genericLiftShowbPrec :: (Generic1 f, GTextShowB One (Rep1 f))+genericLiftShowbPrec :: (Generic1 f, GTextShowB1 (Rep1 f)) => (Int -> a -> Builder) -> ([a] -> Builder) -> Int -> f a -> Builder-genericLiftShowbPrec sp sl p = gShowbPrec (Show1FunsB sp sl) p . from1+genericLiftShowbPrec sp sl p = gLiftShowbPrec 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)+ , GTextShowB (Rep a ())+ , GTextShowB1 (Rep1 f) ) => Int -> f a -> Builder genericShowbPrec1 = genericLiftShowbPrec genericShowbPrec genericShowbList +-- | A type-specialized version of 'from' used to assist type inference.+fromRepUnit :: Generic a => a -> Rep a ()+fromRepUnit = from+ ------------------------------------------------------------------------------- -- | Whether a constructor is a record ('Rec'), a tuple ('Tup'), is prefix ('Pref'),@@ -362,22 +332,9 @@ , Ord , Read , Show- , Typeable-#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@@ -394,229 +351,335 @@ See #33. -} -#if __GLASGOW_HASKELL__ >= 708-#define DERIVE_TYPEABLE(name) deriving instance Typeable name-#else-#define DERIVE_TYPEABLE(name)-#endif+hashPrec :: Int -> Int+hashPrec = const 0 -#if __GLASGOW_HASKELL__ >= 711-#define HASH_FUNS(text_type,one_hash,two_hash,hash_prec,from_char,from_string) \+#define HASH_FUNS(text_type,one_hash,two_hash,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+two_hash = from_string "##";++-- For some mysterious reason, attaching INLINE pragmas to things in this+-- module causes GHC 8.10's simplifier to absolutely explode in terms of+-- compile times. This also affects 9.0, 8.8, and older versions of GHC to+-- varying degrees, usually adding a couple of minutes or more to the overall+-- compile times.+--+-- We'd still like to include the INLINE pragmas on 9.2 or later, however, as+-- it delivers a modest but measurable performance boost in the benchmark suite.+-- As a compromise, we use CPP to only attach INLINE annotations on 9.2 or+-- later.+#if __GLASGOW_HASKELL__ >= 902+#define INLINE_GE_902(f) {-# INLINE f #-}; #else-#define 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+#define INLINE_GE_902(f) #endif -#if __GLASGOW_HASKELL__ >= 708-#define EMPTY_CASE(x) case x of {}+#if __GLASGOW_HASKELL__ >= 806+#define QUANTIFIED_SUPERCLASS(class_name,f) (forall a. TextShow a => class_name (f a)) => #else-#define EMPTY_CASE(x) case x of !_ -> undefined+#define QUANTIFIED_SUPERCLASS(class_name,f) #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'). \+#define GTEXT_SHOW(text_type,show_funs,one_hash,two_hash,gtext_show,gtext_show1,gshow_prec,glift_show_prec,gtext_show_con,gtext_show_con1,gshow_prec_con,glift_show_prec_con,show_prec,lift_show_prec,show_space,show_paren,show_list,show_list_with,from_char,from_string,c1_show_prec,s1_show_prec,product_show_prec,u_char_show_prec,u_double_show_prec,u_float_show_prec,u_int_show_prec,u_word_show_prec) \+{- | Class of generic representation types that can be converted to a \+'text_type'. \ \-/Since: 3.4/ \+/Since: 3.10/ \ -}; \-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; \+class gtext_show a where { \+ ; gshow_prec :: Int -> a -> text_type \+}; \ \-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) \- }; \+instance gtext_show (f p) => gtext_show (D1 d f p) where { \+ ; gshow_prec p (M1 x) = gshow_prec p x \+}; \ \-{- | 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. \+instance gtext_show (V1 p) where { \+ ; gshow_prec _ x = case x of {} \+}; \ \-/Since: 3.4/ \+instance (gtext_show (f p), gtext_show (g p)) \+ => gtext_show ((f :+: g) p) where { \+ ; gshow_prec p (L1 x) = gshow_prec p x \+ ; gshow_prec p (R1 x) = gshow_prec p x \+}; \+ \+instance (Constructor c, gtext_show_con (f p), IsNullary f) \+ => gtext_show (C1 c f p) where { \+ gshow_prec = c1_show_prec gshow_prec_con \+}; \+ \+{- | Class of generic representation types for which the 'ConType' has been \+determined. \+ \+/Since: 3.10/ \ -}; \-class gtext_show 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 \- }; \+class gtext_show_con a where { \+ ; gshow_prec_con :: ConType -> Int -> a -> text_type \+}; \ \-DERIVE_TYPEABLE(gtext_show); \+instance gtext_show_con (U1 p) where { \+ ; gshow_prec_con _ _ U1 = mempty \+}; \ \-instance gtext_show arity f => gtext_show arity (D1 d f) where { \- gshow_prec sfs p (M1 x) = gshow_prec sfs p x \- }; \+instance TextShow p => gtext_show_con (Par1 p) where { \+ ; gshow_prec_con _ p (Par1 x) = show_prec p x \+}; \ \-instance gtext_show arity V1 where { \- gshow_prec _ _ x = EMPTY_CASE(x) \- }; \+instance TextShow c => gtext_show_con (K1 i c p) where { \+ ; gshow_prec_con _ p (K1 x) = show_prec p x \+}; \ \-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 (TextShow1 f, TextShow p) => gtext_show_con (Rec1 f p) where { \+ ; gshow_prec_con _ p (Rec1 x) = lift_show_prec show_prec show_list p x \+}; \ \-instance (Constructor c, gtext_show_con arity f, IsNullary f) \- => gtext_show arity (C1 c f) where { \- gshow_prec sfs p c@(M1 x) = case fixity of { \- Prefix -> show_paren ( p > appPrec \- && not (isNullary x || conIsTuple c) \- ) $ \- (if conIsTuple c \- then mempty \- else let cn = conName c \- in show_paren (isInfixDataCon cn) $ from_string cn) \- <> (if isNullary x || conIsTuple c \- then mempty \- else from_char ' ') \- <> showbBraces t (gshow_prec_con t sfs appPrec1 x) \- ; Infix _ m -> show_paren (p > m) $ gshow_prec_con t sfs (m+1) x \- } \- where { \- fixity :: Fixity \- ; fixity = conFixity c \+instance (Selector s, gtext_show_con (f p)) => gtext_show_con (S1 s f p) where { \+ ; gshow_prec_con t = s1_show_prec $ gshow_prec_con t \+}; \ \- ; 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 \- }; \- } \+instance (gtext_show_con (f p), gtext_show_con (g p)) \+ => gtext_show_con ((f :*: g) p) where { \+ ; gshow_prec_con t = product_show_prec (gshow_prec_con t) (gshow_prec_con t) t \+}; \ \- ; 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 \+instance (TextShow1 f, gtext_show_con (g p)) => gtext_show_con ((f :.: g) p) where { \+ ; gshow_prec_con t p (Comp1 x) = \+ let gspc = gshow_prec_con t \+ in lift_show_prec gspc (show_list_with (gspc 0)) p x \+}; \ \- ; conIsTuple :: C1 c f p -> Bool \- ; conIsTuple = isTupleString . conName \- }; \- }; \+instance gtext_show_con (UChar p) where { \+ ; gshow_prec_con _ = u_char_show_prec show_prec \+}; \ \-{- | 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. \+instance gtext_show_con (UDouble p) where { \+ ; gshow_prec_con _ = u_double_show_prec show_prec \+}; \+ \+instance gtext_show_con (UFloat p) where { \+ ; gshow_prec_con _ = u_float_show_prec show_prec \+}; \+ \+instance gtext_show_con (UInt p) where { \+ ; gshow_prec_con _ = u_int_show_prec show_prec \+}; \+ \+instance gtext_show_con (UWord p) where { \+ ; gshow_prec_con _ = u_word_show_prec show_prec \+}; \+ \+{- | Class of generic representation types for unary type constructors that can \+be converted to a 'text_type'. \+ \+/Since: 3.10/ \ -}; \-class 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 \- }; \+class QUANTIFIED_SUPERCLASS(gtext_show,f) \+ gtext_show1 f where { \+ ; glift_show_prec :: (Int -> a -> text_type) -> ([a] -> text_type) \+ -> Int -> f a -> text_type \+}; \ \-DERIVE_TYPEABLE(gtext_show_con); \+instance gtext_show1 f => gtext_show1 (D1 d f) where { \+ ; glift_show_prec sp sl p (M1 x) = glift_show_prec sp sl p x \+}; \ \-instance gtext_show_con arity U1 where { \- gshow_prec_con _ _ _ U1 = mempty \- }; \+instance gtext_show1 V1 where { \+ ; glift_show_prec _ _ _ x = case x of {} \+}; \ \-instance gtext_show_con One Par1 where { \- gshow_prec_con _ (show1_funs sp _) p (Par1 x) = sp p x \- }; \+instance (gtext_show1 f, gtext_show1 g) => gtext_show1 (f :+: g) where { \+ ; glift_show_prec sp sl p (L1 x) = glift_show_prec sp sl p x \+ ; glift_show_prec sp sl p (R1 x) = glift_show_prec sp sl p x \+}; \ \-instance TextShow c => gtext_show_con arity (K1 i c) where { \- gshow_prec_con _ _ p (K1 x) = show_prec p x \- }; \+instance (Constructor c, gtext_show_con1 f, IsNullary f) \+ => gtext_show1 (C1 c f) where { \+ ; glift_show_prec sp sl = c1_show_prec $ glift_show_prec_con sp sl \+}; \ \-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 \- }; \+{- | Class of generic representation types for unary type constructors for which \+the 'ConType' has been determined. \ \-instance (Selector s, gtext_show_con arity f) => gtext_show_con arity (S1 s f) where { \- gshow_prec_con t sfs p sel@(M1 x) \- | selName sel == "" = gshow_prec_con t sfs p x \- | otherwise = infixRec \- <> " = " \- <> gshow_prec_con t sfs 0 x \- where { \- infixRec :: text_type \- ; infixRec | isSymVar selectorName \- = from_char '(' <> from_string selectorName <> from_char ')' \- | otherwise \- = from_string selectorName \+/Since: 3.10/ \+-}; \+class QUANTIFIED_SUPERCLASS(gtext_show_con,f) \+ gtext_show_con1 f where { \+ ; glift_show_prec_con :: (Int -> a -> text_type) -> ([a] -> text_type) \+ -> ConType -> Int -> f a -> text_type \+}; \ \- ; selectorName :: String \- ; selectorName = selName sel \- } \- }; \+instance gtext_show_con1 U1 where { \+ ; glift_show_prec_con _ _ _ _ U1 = mempty \+}; \ \-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 \+instance gtext_show_con1 Par1 where { \+ ; glift_show_prec_con sp _ _ p (Par1 x) = sp p x \+}; \+ \+instance TextShow c => gtext_show_con1 (K1 i c) where { \+ ; glift_show_prec_con _ _ _ p (K1 x) = show_prec p x \+}; \+ \+instance TextShow1 f => gtext_show_con1 (Rec1 f) where { \+ ; glift_show_prec_con sp sl _ p (Rec1 x) = lift_show_prec sp sl p x \+}; \+ \+instance (Selector s, gtext_show_con1 f) => gtext_show_con1 (S1 s f) where { \+ ; glift_show_prec_con sp sl t = s1_show_prec $ glift_show_prec_con sp sl t \+}; \+ \+instance (gtext_show_con1 f, gtext_show_con1 g) \+ => gtext_show_con1 (f :*: g) where { \+ ; glift_show_prec_con sp sl t = \+ product_show_prec (glift_show_prec_con sp sl t) (glift_show_prec_con sp sl t) t \+}; \+ \+instance (TextShow1 f, gtext_show_con1 g) => gtext_show_con1 (f :.: g) where { \+ ; glift_show_prec_con sp sl t p (Comp1 x) = \+ let gspc = glift_show_prec_con sp sl t \+ in lift_show_prec gspc (show_list_with (gspc 0)) p x \+}; \+ \+instance gtext_show_con1 UChar where { \+ ; glift_show_prec_con _ _ _ = u_char_show_prec show_prec \+}; \+ \+instance gtext_show_con1 UDouble where { \+ ; glift_show_prec_con _ _ _ = u_double_show_prec show_prec \+}; \+ \+instance gtext_show_con1 UFloat where { \+ ; glift_show_prec_con _ _ _ = u_float_show_prec show_prec \+}; \+ \+instance gtext_show_con1 UInt where { \+ ; glift_show_prec_con _ _ _ = u_int_show_prec show_prec \+}; \+ \+instance gtext_show_con1 UWord where { \+ ; glift_show_prec_con _ _ _ = u_word_show_prec show_prec \+}; \+ \+c1_show_prec :: forall c f p. \+ (Constructor c, IsNullary f) \+ => (ConType -> Int -> f p -> text_type) \+ -> Int -> C1 c f p -> text_type; \+c1_show_prec sp p c@(M1 x) = case fixity of { \+ ; Prefix -> show_paren ( p > appPrec \+ && not (isNullary x || conIsTuple c) \+ ) $ \+ (if conIsTuple c \+ then mempty \+ else let cn = conName c \+ in show_paren (isInfixDataCon cn) $ from_string cn) \+ <> (if isNullary x || conIsTuple c \+ then mempty \+ else from_char ' ') \+ <> showBraces t (sp t appPrec1 x) \+ ; Infix _ m -> show_paren (p > m) $ sp t (m+1) x \+} where { \+ ; fixity :: Fixity \+ ; fixity = conFixity c \+ \+ ; t :: ConType \+ ; t = if conIsRecord c \+ then Rec \+ else case conIsTuple c of { \+ ; True -> Tup \+ ; False -> case fixity of { \+ ; Prefix -> Pref \+ ; Infix _ _ -> Inf $ conName c \+ }; \+ }; \+ \+ ; showBraces :: ConType -> text_type -> text_type \+ ; showBraces Rec b = from_char '{' <> b <> from_char '}' \+ ; showBraces Tup b = from_char '(' <> b <> from_char ')' \+ ; showBraces Pref b = b \+ ; showBraces (Inf _) b = b \+ \+ ; conIsTuple :: C1 c f p -> Bool \+ ; conIsTuple = isTupleString . conName \+ }; \+INLINE_GE_902(c1_show_prec) \+ \+s1_show_prec :: Selector s \+ => (Int -> f p -> text_type) \+ -> Int -> S1 s f p -> text_type; \+s1_show_prec sp p sel@(M1 x) \+ | selName sel == "" = sp p x \+ | otherwise = infixRec \+ <> " = " \+ <> sp 0 x \+ where { \+ ; infixRec :: text_type \+ ; infixRec | isSymVar selectorName \+ = from_char '(' <> from_string selectorName <> from_char ')' \+ | otherwise \+ = from_string selectorName \+ \+ ; selectorName :: String \+ ; selectorName = selName sel \+ }; \+INLINE_GE_902(s1_show_prec) \+ \+product_show_prec :: (Int -> f p -> text_type) -> (Int -> g p -> text_type) \+ -> ConType -> Int -> (f :*: g) p -> text_type; \+product_show_prec spf spg t p (a :*: b) = \+ case t of { \+ ; Rec -> \+ spf 0 a \ <> ", " \- <> gshow_prec_con t sfs 0 b \- ; gshow_prec_con t@(Inf o) sfs p (a :*: b) = \- gshow_prec_con t sfs p a \+ <> spg 0 b \+ ; Inf o -> \+ spf p a \ <> show_space \- <> infixOp \+ <> infixOp o \ <> show_space \- <> gshow_prec_con t sfs p b \- where { \- infixOp :: text_type \- ; infixOp = if isInfixDataCon o \- then from_string o \- else from_char '`' <> from_string o <> from_char '`' \- } \- ; gshow_prec_con t@Tup sfs _ (a :*: b) = \- gshow_prec_con t sfs 0 a \+ <> spg p b \+ ; Tup -> \+ spf 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 \+ <> spg 0 b \+ ; Pref -> \+ spf 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 \- }; \+ <> spg p b \+ } where { \+ ; infixOp :: String -> text_type \+ ; infixOp o = if isInfixDataCon o \+ then from_string o \+ else from_char '`' <> from_string o <> from_char '`' \+ }; \+INLINE_GE_902(product_show_prec) \ \-instance gtext_show_con arity UChar where { \- gshow_prec_con _ _ p (UChar c) = show_prec (hash_prec p) (C# c) <> one_hash \- }; \+u_char_show_prec :: (Int -> Char -> text_type) -> Int -> UChar p -> text_type; \+u_char_show_prec sp p (UChar c) = sp (hashPrec p) (C# c) <> one_hash; \+INLINE_GE_902(u_char_show_prec) \ \-instance gtext_show_con arity UDouble where { \- gshow_prec_con _ _ p (UDouble d) = show_prec (hash_prec p) (D# d) <> two_hash \- }; \+u_double_show_prec :: (Int -> Double -> text_type) -> Int -> UDouble p -> text_type; \+u_double_show_prec sp p (UDouble d) = sp (hashPrec p) (D# d) <> two_hash; \+INLINE_GE_902(u_double_show_prec) \ \-instance gtext_show_con arity UFloat where { \- gshow_prec_con _ _ p (UFloat f) = show_prec (hash_prec p) (F# f) <> one_hash \- }; \+u_float_show_prec :: (Int -> Float -> text_type) -> Int -> UFloat p -> text_type; \+u_float_show_prec sp p (UFloat f) = sp (hashPrec p) (F# f) <> one_hash; \+INLINE_GE_902(u_float_show_prec) \ \-instance gtext_show_con arity UInt where { \- gshow_prec_con _ _ p (UInt i) = show_prec (hash_prec p) (I# i) <> one_hash \- }; \+u_int_show_prec :: (Int -> Int -> text_type) -> Int -> UInt p -> text_type; \+u_int_show_prec sp p (UInt i) = sp (hashPrec p) (I# i) <> one_hash; \+INLINE_GE_902(u_int_show_prec) \ \-instance gtext_show_con arity UWord where { \- gshow_prec_con _ _ p (UWord w) = show_prec (hash_prec p) (W# w) <> two_hash \- }; \+u_word_show_prec :: (Int -> Word -> text_type) -> Int -> UWord p -> text_type; \+u_word_show_prec sp p (UWord w) = sp (hashPrec p) (W# w) <> two_hash; \+INLINE_GE_902(u_word_show_prec) \ \-HASH_FUNS(text_type,one_hash,two_hash,hash_prec,from_char,from_string);+HASH_FUNS(text_type,one_hash,two_hash,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)+GTEXT_SHOW(Builder,ShowFunsB,oneHashB,twoHashB,GTextShowB,GTextShowB1,gShowbPrec,gLiftShowbPrec,GTextShowConB,GTextShowConB1,gShowbPrecCon,gLiftShowbPrecCon,showbPrec,liftShowbPrec,showbSpace,showbParen,showbList,showbListWith,TB.singleton,TB.fromString,c1ShowbPrec,s1ShowbPrec,productShowbPrec,uCharShowbPrec,uDoubleShowbPrec,uFloatShowbPrec,uIntShowbPrec,uWordShowbPrec)+GTEXT_SHOW(TS.Text,ShowFunsT,oneHashT,twoHashT,GTextShowT,GTextShowT1,gShowtPrec,gLiftShowtPrec,GTextShowConT,GTextShowConT1,gShowtPrecCon,gLiftShowtPrecCon,showtPrec,liftShowtPrec,showtSpace,showtParen,showtList,showtListWith,TS.singleton,TS.pack,c1ShowtPrec,s1ShowtPrec,productShowtPrec,uCharShowtPrec,uDoubleShowtPrec,uFloatShowtPrec,uIntShowtPrec,uWordShowtPrec)+GTEXT_SHOW(TL.Text,ShowFunsTL,oneHashTL,twoHashTL,GTextShowTL,GTextShowTL1,gShowtlPrec,gLiftShowtlPrec,GTextShowConTL,GTextShowConTL1,gShowtlPrecCon,gLiftShowtlPrecCon,showtlPrec,liftShowtlPrec,showtlSpace,showtlParen,showtlList,showtlListWith,TL.singleton,TL.pack,c1ShowtlPrec,s1ShowtlPrec,productShowtlPrec,uCharShowtlPrec,uDoubleShowtlPrec,uFloatShowtlPrec,uIntShowtlPrec,uWordShowtlPrec) -- | Class of generic representation types that represent a constructor with -- zero or more fields.@@ -663,21 +726,3 @@ ------------------------------------------------------------------------------- $(deriveTextShow ''ConType)--#if __GLASGOW_HASKELL__ < 800-$(deriveLift ''ConType)-$(deriveLift ''FromGeneric)--instance Lift (f a) => Lift (FromGeneric1 f a) where- lift = $(makeLift ''FromGeneric1)-#endif--#if !defined(__LANGUAGE_DERIVE_GENERIC1__)-$(Generics.deriveMeta ''FromGeneric1)-$(Generics.deriveRepresentable1 ''FromGeneric1)-#endif--#if __GLASGOW_HASKELL__ < 706-$(Generics.deriveAll0And1 ''FromGeneric)-$(Generics.deriveRepresentable0 ''FromGeneric1)-#endif
src/TextShow/Instances.hs view
@@ -18,6 +18,7 @@ import TextShow.Control.Monad.ST () import TextShow.Data.Array ()+import TextShow.Data.Array.Byte () import TextShow.Data.Bool () import TextShow.Data.ByteString () import TextShow.Data.Char ()@@ -36,7 +37,6 @@ 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 ()
src/TextShow/Numeric/Natural.hs view
@@ -1,8 +1,6 @@ {-# LANGUAGE CPP #-}-#if MIN_VERSION_base(4,8,0) {-# LANGUAGE MagicHash #-}-#endif-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Numeric.Natural Copyright: (C) 2014-2017 Ryan Scott@@ -18,17 +16,15 @@ module TextShow.Numeric.Natural () where #if MIN_VERSION_base(4,15,0)+import GHC.Exts (Word(..)) import GHC.Num (integerFromNatural) import GHC.Num.Natural (Natural(..))-#elif MIN_VERSION_base(4,8,0)+#elif defined(MIN_VERSION_integer_gmp)+import GHC.Exts (Word(..)) import GHC.Integer.GMP.Internals (Integer(..)) import GHC.Natural (Natural(..)) #else-import Numeric.Natural.Compat (Natural)-#endif--#if MIN_VERSION_base(4,8,0)-import GHC.Exts (Word(..))+import Numeric.Natural (Natural) #endif import TextShow.Classes (TextShow(..))@@ -39,7 +35,7 @@ #if MIN_VERSION_base(4,15,0) showbPrec p (NS w) = showbPrec p (W# w) showbPrec p n = showbPrec p (integerFromNatural n)-#elif MIN_VERSION_base(4,8,0)+#elif defined(MIN_VERSION_integer_gmp) showbPrec _ (NatS# w#) = showb $ W# w# showbPrec p (NatJ# bn) = showbPrec p $ Jp# bn #else
src/TextShow/Options.hs view
@@ -1,12 +1,6 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}--#if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE DeriveLift #-}-#endif {-| Module: TextShow.Options@@ -22,12 +16,12 @@ -} module TextShow.Options (Options(..), GenTextMethods(..), defaultOptions) where -import Data.Data (Data, Typeable)+import Data.Data (Data) import Data.Ix (Ix) import GHC.Generics (Generic) -import Language.Haskell.TH.Lift+import Language.Haskell.TH.Syntax (Lift) -- | Options that specify how to derive 'TextShow' instances using Template Haskell. --@@ -42,8 +36,6 @@ -- ^ If 'True', derived instances for empty data types (i.e., ones with -- no data constructors) will use the @EmptyCase@ language extension. -- If 'False', derived instances will simply use 'seq' instead.- -- (This has no effect on GHCs before 7.8, since @EmptyCase@ is only- -- available in 7.8 or later.) -- -- /Since: 3.7/ } deriving ( Data@@ -52,10 +44,7 @@ , Ord , Read , Show- , Typeable-#if __GLASGOW_HASKELL__ >= 800 , Lift-#endif ) -- | When should Template Haskell generate implementations for the methods of@@ -75,10 +64,7 @@ , Ord , Read , Show- , Typeable-#if __GLASGOW_HASKELL__ >= 800 , Lift-#endif ) -- | Sensible default 'Options'.@@ -89,10 +75,3 @@ Options { genTextMethods = SometimesTextMethods , emptyCaseBehavior = False }-----------------------------------------------------------------------------------#if __GLASGOW_HASKELL__ < 800-$(deriveLift ''Options)-$(deriveLift ''GenTextMethods)-#endif
src/TextShow/System/Exit.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.System.Exit Copyright: (C) 2014-2017 Ryan Scott
src/TextShow/System/IO.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.System.IO Copyright: (C) 2014-2017 Ryan Scott
src/TextShow/System/Posix/Types.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.System.Posix.Types
src/TextShow/TH.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.TH
src/TextShow/TH/Internal.hs view
@@ -1,8 +1,8 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE TemplateHaskell #-} {-| Module: TextShow.TH.Internal Copyright: (C) 2014-2017 Ryan Scott@@ -58,9 +58,9 @@ import Control.Monad (unless, when) import qualified Control.Monad as Monad (fail)-import Data.Foldable.Compat-import qualified Data.List.Compat as List-import Data.List.NonEmpty.Compat (NonEmpty(..), (<|))+import Data.Foldable+import qualified Data.List as List+import Data.List.NonEmpty (NonEmpty(..), (<|)) import qualified Data.Map as Map (fromList, keys, lookup, singleton) import Data.Map (Map) import Data.Maybe@@ -78,12 +78,29 @@ , Char#, Double#, Float#, Int#, Word# #if MIN_VERSION_base(4,13,0) , Int8#, Int16#, Word8#, Word16#+# if MIN_VERSION_base(4,16,0)+ , Int32#, Word32#+# if MIN_VERSION_base(4,19,0)+ , Int64#, Word64#+# else+ , int8ToInt#, int16ToInt#, int32ToInt#+ , intToInt8#, intToInt16#, intToInt32#+ , word8ToWord#, word16ToWord#, word32ToWord#+ , wordToWord8#, wordToWord16#, wordToWord32#+# endif+# else , extendInt8#, extendInt16#, extendWord8#, extendWord16#+ , narrowInt8#, narrowInt16#, narrowWord8#, narrowWord16#+# endif #endif ) import GHC.Show (appPrec, appPrec1)+#if MIN_VERSION_base(4,19,0)+import GHC.Int (Int8(..), Int16(..), Int32(..), Int64(..))+import GHC.Word (Word8(..), Word16(..), Word32(..), Word64(..))+#endif -import Language.Haskell.TH.Datatype+import Language.Haskell.TH.Datatype as Datatype import Language.Haskell.TH.Lib import Language.Haskell.TH.Ppr hiding (appPrec) import Language.Haskell.TH.Syntax@@ -534,7 +551,7 @@ splMap = Map.fromList $ zip lastTyVars spls makeFun- | null cons && emptyCaseBehavior opts && ghc7'8OrLater+ | null cons && emptyCaseBehavior opts = caseE (varE value) [] | null cons@@ -552,13 +569,6 @@ , makeFun ] ++ map varE spsAndSls ++ [varE p, varE value]- where- ghc7'8OrLater :: Bool-#if __GLASGOW_HASKELL__ >= 708- ghc7'8OrLater = True-#else- ghc7'8OrLater = False-#endif -- | Generates a lambda expression for showbPrec/liftShowbPrec/etc. for a -- single constructor.@@ -708,19 +718,11 @@ Nothing -> showPrecE `appE` integerE p `appE` tyVarE showPrimE :: PrimShow -> Q Exp- showPrimE PrimShow{ primShowBoxer-#if __GLASGOW_HASKELL__ >= 800- , primShowPostfixMod, primShowConv-#endif- }-#if __GLASGOW_HASKELL__ >= 800+ showPrimE PrimShow{ primShowBoxer, primShowPostfixMod, primShowConv } -- Starting with GHC 8.0, data types containing unlifted types with -- derived Show instances show hashed literals with actual hash signs, -- and negative hashed literals are not surrounded with parentheses. = primShowConv tsFun $ infixApp (primE 0) [| (<>) |] (primShowPostfixMod tsFun)-#else- = primE p-#endif where primE :: Int -> Q Exp primE prec = showPrecE `appE` integerE prec `appE` primShowBoxer tyVarE@@ -872,14 +874,15 @@ map (substNamesWithKindStar (List.union droppedKindVarNames kvNames')) $ take remainingLength varTysOrig - isDataFamily :: Bool- isDataFamily = case variant of- Datatype -> False- Newtype -> False- DataInstance -> True- NewtypeInstance -> True+ isDataFamily <-+ case variant of+ Datatype -> return False+ Newtype -> return False+ DataInstance -> return True+ NewtypeInstance -> return True+ Datatype.TypeData -> typeDataError tyConName - remainingTysOrigSubst' :: [Type]+ let remainingTysOrigSubst' :: [Type] -- See Note [Kind signatures in derived instances] for an explanation -- of the isDataFamily check. remainingTysOrigSubst' =@@ -896,7 +899,7 @@ -- 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) $+ when (any (`mentionsName` droppedTyVarNames) dataCxt) $ datatypeContextError tyConName instanceType -- Also ensure the dropped types can be safely eta-reduced. Otherwise, -- throw an error.@@ -1060,19 +1063,21 @@ n :: Int n = fromEnum tsClass +-- | We cannot implement class methods at the term level for @type data@+-- declarations, which only exist at the type level.+typeDataError :: Name -> Q a+typeDataError dataName = Monad.fail+ . showString "Cannot derive instance for ‘"+ . showString (nameBase dataName)+ . showString "‘, which is a ‘type data‘ declaration"+ $ ""+ ------------------------------------------------------------------------------- -- Expanding type synonyms ------------------------------------------------------------------------------- -applySubstitutionKind :: Map Name Kind -> Type -> Type-#if MIN_VERSION_template_haskell(2,8,0)-applySubstitutionKind = applySubstitution-#else-applySubstitutionKind _ t = t-#endif- substNameWithKind :: Name -> Kind -> Type -> Type-substNameWithKind n k = applySubstitutionKind (Map.singleton n k)+substNameWithKind n k = applySubstitution (Map.singleton n k) substNamesWithKindStar :: [Name] -> Type -> Type substNamesWithKindStar ns t = foldr' (flip substNameWithKind starK) t ns@@ -1203,9 +1208,7 @@ 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.@@ -1256,44 +1259,168 @@ , primShowPostfixMod = twoHashE , primShowConv = \_ x -> x })-#if MIN_VERSION_base(4,13,0)+#if MIN_VERSION_base(4,19,0) , (''Int8#, PrimShow- { primShowBoxer = appE (conE 'I#) . appE (varE 'extendInt8#)+ { primShowBoxer = appE (conE 'I8#)+ , primShowPostfixMod = extendedLitE "Int8"+ , primShowConv = \_ x -> x+ })+ , (''Int16#, PrimShow+ { primShowBoxer = appE (conE 'I16#)+ , primShowPostfixMod = extendedLitE "Int16"+ , primShowConv = \_ x -> x+ })+ , (''Int32#, PrimShow+ { primShowBoxer = appE (conE 'I32#)+ , primShowPostfixMod = extendedLitE "Int32"+ , primShowConv = \_ x -> x+ })+ , (''Int64#, PrimShow+ { primShowBoxer = appE (conE 'I64#)+ , primShowPostfixMod = extendedLitE "Int64"+ , primShowConv = \_ x -> x+ })+ , (''Word8#, PrimShow+ { primShowBoxer = appE (conE 'W8#)+ , primShowPostfixMod = extendedLitE "Word8"+ , primShowConv = \_ x -> x+ })+ , (''Word16#, PrimShow+ { primShowBoxer = appE (conE 'W16#)+ , primShowPostfixMod = extendedLitE "Word16"+ , primShowConv = \_ x -> x+ })+ , (''Word32#, PrimShow+ { primShowBoxer = appE (conE 'W32#)+ , primShowPostfixMod = extendedLitE "Word32"+ , primShowConv = \_ x -> x+ })+ , (''Word64#, PrimShow+ { primShowBoxer = appE (conE 'W64#)+ , primShowPostfixMod = extendedLitE "Word64"+ , primShowConv = \_ x -> x+ })+#else+# if MIN_VERSION_base(4,13,0)+ , (''Int8#, PrimShow+ { primShowBoxer = appE (conE 'I#) . appE (varE int8ToIntHashValName) , primShowPostfixMod = oneHashE- , primShowConv = mkNarrowE "narrowInt8#"+ , primShowConv = mkNarrowE intToInt8HashValName }) , (''Int16#, PrimShow- { primShowBoxer = appE (conE 'I#) . appE (varE 'extendInt16#)+ { primShowBoxer = appE (conE 'I#) . appE (varE int16ToIntHashValName) , primShowPostfixMod = oneHashE- , primShowConv = mkNarrowE "narrowInt16#"+ , primShowConv = mkNarrowE intToInt16HashValName }) , (''Word8#, PrimShow- { primShowBoxer = appE (conE 'W#) . appE (varE 'extendWord8#)+ { primShowBoxer = appE (conE 'W#) . appE (varE word8ToWordHashValName) , primShowPostfixMod = twoHashE- , primShowConv = mkNarrowE "narrowWord8#"+ , primShowConv = mkNarrowE wordToWord8HashValName }) , (''Word16#, PrimShow- { primShowBoxer = appE (conE 'W#) . appE (varE 'extendWord16#)+ { primShowBoxer = appE (conE 'W#) . appE (varE word16ToWordHashValName) , primShowPostfixMod = twoHashE- , primShowConv = mkNarrowE "narrowWord16#"+ , primShowConv = mkNarrowE wordToWord16HashValName })+# endif+# if MIN_VERSION_base(4,16,0)+ , (''Int32#, PrimShow+ { primShowBoxer = appE (conE 'I#) . appE (varE 'int32ToInt#)+ , primShowPostfixMod = oneHashE+ , primShowConv = mkNarrowE 'intToInt32#+ })+ , (''Word32#, PrimShow+ { primShowBoxer = appE (conE 'W#) . appE (varE 'word32ToWord#)+ , primShowPostfixMod = twoHashE+ , primShowConv = mkNarrowE 'wordToWord32#+ })+# endif #endif ] -#if MIN_VERSION_base(4,13,0)-mkNarrowE :: String -> TextShowFun -> Q Exp -> Q Exp-mkNarrowE narrowStr tsFun e =+#if MIN_VERSION_base(4,13,0) && !(MIN_VERSION_base(4,19,0))+mkNarrowE :: Name -> TextShowFun -> Q Exp -> Q Exp+mkNarrowE narrowName tsFun e = foldr (`infixApp` [| (<>) |]) (varE (singletonName tsFun) `appE` charE ')')- [ varE (fromStringName tsFun) `appE` stringE ('(':narrowStr ++ " ")+ [ varE (fromStringName tsFun) `appE` stringE ('(':nameBase narrowName ++ " ") , e ]++int8ToIntHashValName :: Name+int8ToIntHashValName =+# if MIN_VERSION_base(4,16,0)+ 'int8ToInt#+# else+ 'extendInt8#+# endif++int16ToIntHashValName :: Name+int16ToIntHashValName =+# if MIN_VERSION_base(4,16,0)+ 'int16ToInt#+# else+ 'extendInt16#+# endif++intToInt8HashValName :: Name+intToInt8HashValName =+# if MIN_VERSION_base(4,16,0)+ 'intToInt8#+# else+ 'narrowInt8#+# endif++intToInt16HashValName :: Name+intToInt16HashValName =+# if MIN_VERSION_base(4,16,0)+ 'intToInt16#+# else+ 'narrowInt16#+# endif++word8ToWordHashValName :: Name+word8ToWordHashValName =+# if MIN_VERSION_base(4,16,0)+ 'word8ToWord#+# else+ 'extendWord8#+# endif++word16ToWordHashValName :: Name+word16ToWordHashValName =+# if MIN_VERSION_base(4,16,0)+ 'word16ToWord#+# else+ 'extendWord16#+# endif++wordToWord8HashValName :: Name+wordToWord8HashValName =+# if MIN_VERSION_base(4,16,0)+ 'wordToWord8#+# else+ 'narrowWord8#+# endif++wordToWord16HashValName :: Name+wordToWord16HashValName =+# if MIN_VERSION_base(4,16,0)+ 'wordToWord16#+# else+ 'narrowWord16#+# endif #endif oneHashE, twoHashE :: TextShowFun -> Q Exp oneHashE tsFun = varE (singletonName tsFun) `appE` charE '#' twoHashE tsFun = varE (fromStringName tsFun) `appE` stringE "##" +#if MIN_VERSION_base(4,19,0)+extendedLitE :: String -> TextShowFun -> Q Exp+extendedLitE suffix tsFun = varE (fromStringName tsFun) `appE` stringE ("#" ++ suffix)+#endif+ ------------------------------------------------------------------------------- -- Assorted utilities -------------------------------------------------------------------------------@@ -1307,21 +1434,13 @@ -- | 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.@@ -1333,7 +1452,7 @@ -- kind variables. hasKindVarChain :: Int -> Type -> Maybe [Name] hasKindVarChain kindArrows t =- let uk = uncurryKind (tyKind t)+ let uk = uncurryTy (tyKind t) in if (length uk - 1 == kindArrows) && all isStarOrVar uk then Just (concatMap freeVariables uk) else Nothing@@ -1362,11 +1481,7 @@ -- | 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:@@ -1427,25 +1542,10 @@ go tcName = do info <- reify tcName case info of-#if MIN_VERSION_template_haskell(2,11,0) FamilyI (OpenTypeFamilyD (TypeFamilyHead _ bndrs _ _)) _ -> withinFirstArgs bndrs-#elif MIN_VERSION_template_haskell(2,7,0)- FamilyI (FamilyD TypeFam _ bndrs _) _- -> withinFirstArgs bndrs-#else- TyConI (FamilyD TypeFam _ bndrs _)- -> withinFirstArgs bndrs-#endif--#if MIN_VERSION_template_haskell(2,11,0) FamilyI (ClosedTypeFamilyD (TypeFamilyHead _ bndrs _ _) _) _ -> withinFirstArgs bndrs-#elif MIN_VERSION_template_haskell(2,9,0)- FamilyI (ClosedTypeFamilyD _ bndrs _ _) _- -> withinFirstArgs bndrs-#endif- _ -> return False where withinFirstArgs :: [a] -> Q Bool@@ -1472,22 +1572,10 @@ 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 (SigT t k) names = go t names || go k names go (VarT n) names = n `elem` names go _ _ = False --- | Does an instance predicate mention any of the Names in the list?-predMentionsName :: Pred -> [Name] -> Bool-#if MIN_VERSION_template_haskell(2,10,0)-predMentionsName = mentionsName-#else-predMentionsName (ClassP n tys) names = n `elem` names || any (`mentionsName` names) tys-predMentionsName (EqualP t1 t2) names = mentionsName t1 names || mentionsName t2 names-#endif- -- | Construct a type via curried application. applyTy :: Type -> [Type] -> Type applyTy = foldl' AppT@@ -1513,10 +1601,8 @@ go :: Type -> Type -> [Type] -> NonEmpty Type go _ (AppT ty1 ty2) args = go ty1 ty1 (ty2:args) go origTy (SigT ty' _) args = go origTy ty' args-#if MIN_VERSION_template_haskell(2,11,0) go origTy (InfixT ty1 n ty2) args = go origTy (ConT n `AppT` ty1 `AppT` ty2) args go origTy (ParensT ty') args = go origTy ty' args-#endif go origTy _ args = origTy :| args -- | Split a type signature by the arrows on its spine. For example, this:@@ -1535,15 +1621,6 @@ 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
src/TextShow/Text/Read.hs view
@@ -1,6 +1,5 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Text.Read Copyright: (C) 2014-2017 Ryan Scott@@ -16,7 +15,7 @@ -} module TextShow.Text.Read () where -import Text.Read.Lex (Lexeme)+import Text.Read.Lex (Lexeme, Number) import TextShow.Data.Char () import TextShow.Data.Integral ()@@ -24,16 +23,9 @@ 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 -#if MIN_VERSION_base(4,6,0)--- | Only available with @base-4.6.0.0@ or later.------ /Since: 2/-$(deriveTextShow numberTypeName)-#endif+-- | /Since: 2/+$(deriveTextShow ''Number) -- | /Since: 2/ $(deriveTextShow ''Lexeme)
src/TextShow/Utils.hs view
@@ -12,8 +12,7 @@ Miscellaneous utility functions. -} module TextShow.Utils (- coerce- , i2d+ i2d , isInfixDataCon , isSymVar , isTupleString@@ -34,26 +33,10 @@ import Prelude () import Prelude.Compat hiding (length) -#if __GLASGOW_HASKELL__ >= 708-import qualified Data.Coerce as C (Coercible, coerce)-#else-import Unsafe.Coerce (unsafeCoerce)-#endif- #if defined(MIN_VERSION_ghc_boot_th) import GHC.Lexeme (startsVarSym) #else import Data.Char (isSymbol, ord)-#endif---- | On GHC 7.8 and later, this is 'C.coerce' from "Data.Coerce". Otherwise, it's--- 'unsafeCoerce'.-#if __GLASGOW_HASKELL__ >= 708-coerce :: C.Coercible a b => a -> b-coerce = C.coerce-#else-coerce :: a -> b-coerce = unsafeCoerce #endif -- | Unsafe conversion for decimal digits.
tests/Derived/DataFamilies.hs view
@@ -1,23 +1,13 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -#if __GLASGOW_HASKELL__ >= 706-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE PolyKinds #-}-#endif--#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710--- Starting with GHC 7.10, NullaryTypeClasses was deprecated in favor of--- MultiParamTypeClasses, which is already enabled-{-# LANGUAGE NullaryTypeClasses #-}-#endif- {-| Module: Derived.DataFamilies Copyright: (C) 2014-2017 Ryan Scott@@ -30,27 +20,12 @@ -} 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 GHC.Generics (Generic, Generic1) import Instances.Utils.GenericArbitrary (genericArbitrary) @@ -59,10 +34,7 @@ import Test.QuickCheck (Arbitrary(..)) -import Text.Show.Deriving (deriveShow1)-#if defined(NEW_FUNCTOR_CLASSES)-import Text.Show.Deriving (deriveShow2)-#endif+import Text.Show.Deriving (deriveShow1, deriveShow2) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) @@ -74,56 +46,34 @@ data instance NotAllShow Int b c d = NASShow1 c b | NASShow2 d deriving ( Show-#if __GLASGOW_HASKELL__ >= 706 , Generic-# if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1-# endif-#endif ) instance (Arbitrary b, Arbitrary c, Arbitrary d) => Arbitrary (NotAllShow Int b c d) where arbitrary = genericArbitrary -#if !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- ------------------------------------------------------------------------------- -#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)@@ -134,17 +84,11 @@ => Arbitrary (KindDistinguished (a :: Bool) b c) where arbitrary = genericArbitrary -# if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 'KindDistinguishedUnit)--$(deriveShow1 'KindDistinguishedBool)-# else-$(deriveShow1 'KindDistinguishedUnit) $(deriveShow2 'KindDistinguishedUnit) $(deriveShow1 'KindDistinguishedBool) $(deriveShow2 'KindDistinguishedBool)-# endif $(deriveTextShow 'KindDistinguishedUnit) $(deriveTextShow1 'KindDistinguishedUnit)@@ -154,15 +98,8 @@ $(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 :: * @@ -171,4 +108,3 @@ deriving (Arbitrary, Show, Generic) $(deriveTextShow 'NullaryCon)-#endif
tests/Derived/DatatypeContexts.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DatatypeContexts #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-}@@ -17,23 +16,18 @@ -} module Derived.DatatypeContexts (TyCon(..), TyFamily(..)) where -import Data.Functor.Classes (Show1(..))+import Data.Functor.Classes (Show1(..), Show2(..)) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) +import Text.Show.Deriving (makeLiftShowsPrec, makeLiftShowsPrec2)+ 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@@ -59,15 +53,9 @@ $(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)@@ -76,16 +64,11 @@ instance (Ord a, TextShow a) => TextShow2 (TyCon a) where liftShowbPrec2 = $(makeLiftShowbPrec2 ''TyCon) -#if !defined(NEW_FUNCTOR_CLASSES) instance (Ord a, Show a, Show b) => Show1 (TyFamily a b) where- showsPrec1 = $(makeShowsPrec1 'TyFamily)-#else-instance (Ord a, Show a, Show b) => Show1 (TyFamily a b) where liftShowsPrec = $(makeLiftShowsPrec 'TyFamily) instance (Ord a, Show a) => Show2 (TyFamily a) where liftShowsPrec2 = $(makeLiftShowsPrec2 'TyFamily)-#endif instance (Ord a, TextShow a, TextShow b, TextShow c) => TextShow (TyFamily a b c) where showbPrec = $(makeShowbPrec 'TyFamily)
tests/Derived/ExistentialQuantification.hs view
@@ -1,9 +1,9 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-| Module: Derived.ExistentialQuantification@@ -22,10 +22,7 @@ import Test.QuickCheck (Arbitrary(..), Gen, oneof) -import Text.Show.Deriving (deriveShow1)-#if defined(NEW_FUNCTOR_CLASSES)-import Text.Show.Deriving (deriveShow2)-#endif+import Text.Show.Deriving (deriveShow1, deriveShow2) import TextShow (TextShow) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2)@@ -101,20 +98,14 @@ ------------------------------------------------------------------------------- $(deriveShow1 ''TyCon)-#if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2 ''TyCon)-#endif $(deriveTextShow ''TyCon) $(deriveTextShow1 ''TyCon) $(deriveTextShow2 ''TyCon) -#if !defined(NEW_FUNCTOR_CLASSES)-$(deriveShow1 'TyFamilyClassConstraints)-#else $(deriveShow1 'TyFamilyTypeRefinement1) $(deriveShow2 'TyFamilyTypeRefinement1)-#endif $(deriveTextShow 'TyFamilyClassConstraints) $(deriveTextShow1 'TyFamilyTypeRefinement1)
tests/Derived/Infix.hs view
@@ -1,14 +1,9 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -#if __GLASGOW_HASKELL__ >= 706-{-# LANGUAGE DataKinds #-}-#endif- {-| Module: Derived.Infix Copyright: (C) 2014-2017 Ryan Scott@@ -26,16 +21,7 @@ , TyFamilyGADT(..) ) where -#include "generic.h"--#if !defined(__LANGUAGE_DERIVE_GENERIC1__)-import qualified Generics.Deriving.TH as Generics-#endif--import GHC.Generics (Generic)-#if __GLASGOW_HASKELL__ >= 706-import GHC.Generics (Generic1)-#endif+import GHC.Generics (Generic, Generic1) import Instances.Utils.GenericArbitrary (genericArbitrary) @@ -44,10 +30,7 @@ import Test.QuickCheck (Arbitrary(..)) -import Text.Show.Deriving (deriveShow1)-#if defined(NEW_FUNCTOR_CLASSES)-import Text.Show.Deriving (deriveShow2)-#endif+import Text.Show.Deriving (deriveShow1, deriveShow2) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) @@ -63,9 +46,7 @@ | TyConFakeInfix a b deriving ( Show , Generic-#if __GLASGOW_HASKELL__ >= 706 , Generic1-#endif ) -------------------------------------------------------------------------------@@ -77,10 +58,8 @@ (:...) :: g -> h -> Int -> TyConGADT g h (:....) :: { tcg1 :: i, tcg2 :: j } -> TyConGADT i j deriving ( Show-#if __GLASGOW_HASKELL__ >= 706 , Generic , Generic1-#endif ) -------------------------------------------------------------------------------@@ -96,12 +75,8 @@ | a `TyFamilyPlain` b | TyFamilyFakeInfix a b deriving ( Show-#if __GLASGOW_HASKELL__ >= 706 , Generic-# if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1-# endif-#endif ) -------------------------------------------------------------------------------@@ -115,12 +90,8 @@ (:***) :: 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 ) -------------------------------------------------------------------------------@@ -140,11 +111,10 @@ ------------------------------------------------------------------------------- $(deriveShow1 ''TyConPlain)-$(deriveShow1 ''TyConGADT)-#if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2 ''TyConPlain)++$(deriveShow1 ''TyConGADT) $(deriveShow2 ''TyConGADT)-#endif $(deriveTextShow ''TyConPlain) $(deriveTextShow1 ''TyConPlain)@@ -154,23 +124,11 @@ $(deriveTextShow1 ''TyConGADT) $(deriveTextShow2 ''TyConGADT) -#if __GLASGOW_HASKELL__ < 706-$(Generics.deriveMeta ''TyConPlain)-$(Generics.deriveRepresentable1 ''TyConPlain)-$(Generics.deriveAll0And1 ''TyConGADT)-#endif--#if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 '(:#:))--$(deriveShow1 '(:*))-#else-$(deriveShow1 '(:#:)) $(deriveShow2 '(:$:)) $(deriveShow1 '(:*)) $(deriveShow2 '(:***))-#endif $(deriveTextShow '(:#:)) $(deriveTextShow1 '(:$:))@@ -179,15 +137,3 @@ $(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
tests/Derived/MagicHash.hs view
@@ -1,13 +1,10 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -#if __GLASGOW_HASKELL__ >= 706-{-# LANGUAGE DataKinds #-}-#endif- {-| Module: Derived.MagicHash Copyright: (C) 2014-2017 Ryan Scott@@ -25,14 +22,8 @@ #endif ) where -#if __GLASGOW_HASKELL__ < 711-import qualified Generics.Deriving.TH as Generics-#endif- import GHC.Exts-#if __GLASGOW_HASKELL__ >= 711 import GHC.Generics (Generic, Generic1)-#endif import Instances.Utils.GenericArbitrary (genericArbitrary) @@ -41,10 +32,8 @@ import Test.QuickCheck (Arbitrary(..)) -import Text.Show.Deriving (deriveShow1Options, legacyShowOptions)-#if defined(NEW_FUNCTOR_CLASSES)-import Text.Show.Deriving (deriveShow2Options)-#endif+import Text.Show.Deriving (deriveShow1Options, deriveShow2Options,+ legacyShowOptions) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) -------------------------------------------------------------------------------@@ -58,10 +47,8 @@ , tcChar# :: Char# , tcWord# :: Word# } deriving ( Show-#if __GLASGOW_HASKELL__ >= 711 , Generic , Generic1-#endif ) #if MIN_VERSION_base(4,13,0)@@ -72,6 +59,10 @@ , tcInt16# :: Int16# , tcWord8# :: Word8# , tcWord16# :: Word16#+# if MIN_VERSION_base(4,16,0)+ , tcInt32# :: Int32#+ , tcWord32# :: Word32#+# endif } deriving Show #endif @@ -88,10 +79,8 @@ , tfChar# :: Char# , tfWord# :: Word# } deriving ( Show-#if __GLASGOW_HASKELL__ >= 711 , Generic , Generic1-#endif ) #if MIN_VERSION_base(4,13,0)@@ -104,6 +93,10 @@ , tfInt16# :: Int16# , tfWord8# :: Word8# , tfWord16# :: Word16#+# if MIN_VERSION_base(4,16,0)+ , tfInt32# :: Int32#+ , tfWord32# :: Word32#+# endif } deriving Show #endif @@ -124,8 +117,15 @@ I# i2 <- arbitrary W# w1 <- arbitrary W# w2 <- arbitrary- pure $ TyCon'# a b (narrowInt8# i1) (narrowInt16# i2)- (narrowWord8# w1) (narrowWord16# w2)+# if MIN_VERSION_base(4,16,0)+ I# i3 <- arbitrary+ W# w3 <- arbitrary+# endif+ pure $ TyCon'# a b (intToInt8Compat# i1) (intToInt16Compat# i2)+ (wordToWord8Compat# w1) (wordToWord16Compat# w2)+# if MIN_VERSION_base(4,16,0)+ (intToInt32# i3) (wordToWord32# w3)+# endif instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamily'# a b) where arbitrary = do@@ -135,39 +135,57 @@ I# i2 <- arbitrary W# w1 <- arbitrary W# w2 <- arbitrary- pure $ TyFamily'# a b (narrowInt8# i1) (narrowInt16# i2)- (narrowWord8# w1) (narrowWord16# w2)+# if MIN_VERSION_base(4,16,0)+ I# i3 <- arbitrary+ W# w3 <- arbitrary+# endif+ pure $ TyFamily'# a b (intToInt8Compat# i1) (intToInt16Compat# i2)+ (wordToWord8Compat# w1) (wordToWord16Compat# w2)+# if MIN_VERSION_base(4,16,0)+ (intToInt32# i3) (wordToWord32# w3)+# endif++# if MIN_VERSION_base(4,16,0)+intToInt8Compat# :: Int# -> Int8#+intToInt8Compat# = intToInt8#++intToInt16Compat# :: Int# -> Int16#+intToInt16Compat# = intToInt16#++wordToWord8Compat# :: Word# -> Word8#+wordToWord8Compat# = wordToWord8#++wordToWord16Compat# :: Word# -> Word16#+wordToWord16Compat# = wordToWord16#+# else+intToInt8Compat# :: Int# -> Int8#+intToInt8Compat# = narrowInt8#++intToInt16Compat# :: Int# -> Int16#+intToInt16Compat# = narrowInt16#++wordToWord8Compat# :: Word# -> Word8#+wordToWord8Compat# = narrowWord8#++wordToWord16Compat# :: Word# -> Word16#+wordToWord16Compat# = narrowWord16#+# endif #endif ------------------------------------------------------------------------------- $(deriveShow1Options legacyShowOptions ''TyCon#)-#if defined(NEW_FUNCTOR_CLASSES)-$(deriveShow2Options legacyShowOptions ''TyCon#)-#endif $(deriveTextShow ''TyCon#) $(deriveTextShow1 ''TyCon#) $(deriveTextShow2 ''TyCon#) -#if __GLASGOW_HASKELL__ < 711-$(Generics.deriveAll0And1 ''TyCon#)-#endif--#if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1Options legacyShowOptions 'TyFamily#)-#else-$(deriveShow1Options legacyShowOptions 'TyFamily#) $(deriveShow2Options legacyShowOptions 'TyFamily#)-#endif $(deriveTextShow 'TyFamily#) $(deriveTextShow1 'TyFamily#) $(deriveTextShow2 'TyFamily#)--#if __GLASGOW_HASKELL__ < 711-$(Generics.deriveAll0And1 'TyFamily#)-#endif #if MIN_VERSION_base(4,13,0) $(deriveShow1Options legacyShowOptions ''TyCon'#)
tests/Derived/PolyKinds.hs view
@@ -1,20 +1,15 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-}+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -#if __GLASGOW_HASKELL__ >= 706-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE PolyKinds #-}-#endif--{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Derived.PolyKinds@@ -35,29 +30,19 @@ , TyFamilyReallyHighKinds(..) ) where -#include "generic.h"--import Data.Functor.Classes (Show1(..))+import Data.Functor.Classes (Show1(..), Show2(..))+import Data.Orphans () -import Generics.Deriving.Base-#if !defined(__LANGUAGE_DERIVE_GENERIC1__)-import qualified Generics.Deriving.TH as Generics-#endif+import GHC.Generics import Test.QuickCheck (Arbitrary) -import Text.Show.Deriving (deriveShow1)+import Text.Show.Deriving (deriveShow1, deriveShow2,+ makeLiftShowsPrec, makeLiftShowsPrec2) 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.@@ -68,11 +53,9 @@ 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)@@ -84,9 +67,7 @@ deriving ( Arbitrary , Show , Generic-#if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1-#endif ) -------------------------------------------------------------------------------@@ -95,103 +76,62 @@ deriving ( Arbitrary , Show , Generic-#if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1-#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- :: *+ (z :: k5) :: * 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- :: *+data family TyFamilyProxy (x :: k1) (y :: k2) :: * 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- :: *+ (z :: k5) :: * 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 ) -------------------------------------------------------------------------------@@ -200,11 +140,8 @@ -- 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)@@ -221,19 +158,7 @@ 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)@@ -255,33 +180,6 @@ instance TextShow2 (f a b c) => TextShow2 (TyConReallyHighKinds f a b c) where liftShowbPrec2 = $(makeLiftShowbPrec2 ''TyConReallyHighKinds) -#if !defined(__LANGUAGE_DERIVE_GENERIC1__)-$(Generics.deriveMeta ''TyConCompose)-$(Generics.deriveRep1Options False ''TyConCompose)--instance ( Functor (f (g (j a) (k a)))- , Functor (h (j a))- ) => Generic1 (TyConCompose f g h j k a) where- type Rep1 (TyConCompose f g h j k a) = $(Generics.makeRep1 ''TyConCompose) f g h j k a- from1 = $(Generics.makeFrom1 ''TyConCompose)- to1 = $(Generics.makeTo1 ''TyConCompose)--$(Generics.deriveMeta ''TyConProxy)-$(Generics.deriveRepresentable1 ''TyConProxy)-$(Generics.deriveMeta ''TyConReallyHighKinds)-$(Generics.deriveRepresentable1 ''TyConReallyHighKinds)-#endif--#if !defined(NEW_FUNCTOR_CLASSES)-instance (Functor (f (g (j a) (k a))), Functor (h (j a)),- Show1 (f (g (j a) (k a))), Show1 (h (j a)), Show1 k) =>- Show1 (TyFamilyCompose f g h j k a) where- showsPrec1 = $(makeShowsPrec1 'TyFamilyCompose)-instance Show1 (TyFamilyProxy (a :: *)) where- showsPrec1 = $(makeShowsPrec1 'TyFamilyProxy)-instance Show1 (f a b c d) => Show1 (TyFamilyReallyHighKinds f a b c d) where- showsPrec1 = $(makeShowsPrec1 'TyFamilyReallyHighKinds)-#else instance (Show1 (f (g (j a) (k a))), Show1 (h (j a)), Show1 k) => Show1 (TyFamilyCompose f g h j k a) where liftShowsPrec = $(makeLiftShowsPrec 'TyFamilyCompose)@@ -297,7 +195,6 @@ 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@@ -319,26 +216,3 @@ 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
tests/Derived/RankNTypes.hs view
@@ -1,12 +1,11 @@-{-# 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 #-}+{-# OPTIONS_GHC -Wno-orphans #-}+{-# OPTIONS_GHC -Wno-name-shadowing #-} {-| Module: Derived.RankNTypes@@ -20,25 +19,19 @@ -} module Derived.RankNTypes (TyCon(..), TyFamily(..)) where -import Data.Functor.Classes (Show1(..))+import Data.Functor.Classes (Show1(..), Show2(..)) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) -import Text.Show.Deriving (deriveShow1)+import Text.Show.Deriving (deriveShow1, deriveShow2,+ makeLiftShowsPrec, makeLiftShowsPrec2) 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)@@ -86,31 +79,19 @@ ------------------------------------------------------------------------------- instance Show1 (Tagged2 s t) where-#if defined(NEW_FUNCTOR_CLASSES) liftShowsPrec = $(makeLiftShowsPrec ''Tagged2)-#else- showsPrec1 = $(makeShowsPrec1 ''Tagged2)-#endif-#if defined(NEW_FUNCTOR_CLASSES) instance Show2 (Tagged2 s) where liftShowsPrec2 = $(makeLiftShowsPrec2 ''Tagged2)-#endif $(deriveShow1 ''TyCon)-#if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2 ''TyCon)-#endif $(deriveTextShow ''TyCon) $(deriveTextShow1 ''TyCon) $(deriveTextShow2 ''TyCon) -#if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 'TyFamily)-#else-$(deriveShow1 'TyFamily) $(deriveShow2 'TyFamily)-#endif $(deriveTextShow 'TyFamily) $(deriveTextShow1 'TyFamily)
tests/Derived/Records.hs view
@@ -1,12 +1,7 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -#if __GLASGOW_HASKELL__ >= 706-{-# LANGUAGE DataKinds #-}-#endif- {-| Module: Derived.Records Copyright: (C) 2014-2017 Ryan Scott@@ -19,16 +14,7 @@ -} module Derived.Records (TyCon(..), TyFamily(..)) where -#include "generic.h"--#if !defined(__LANGUAGE_DERIVE_GENERIC1__)-import qualified Generics.Deriving.TH as Generics-#endif--import GHC.Generics (Generic)-#if __GLASGOW_HASKELL__ >= 706-import GHC.Generics (Generic1)-#endif+import GHC.Generics (Generic, Generic1) import Instances.Utils.GenericArbitrary (genericArbitrary) @@ -37,10 +23,7 @@ import Test.QuickCheck (Arbitrary(..)) -import Text.Show.Deriving (deriveShow1)-#if defined(NEW_FUNCTOR_CLASSES)-import Text.Show.Deriving (deriveShow2)-#endif+import Text.Show.Deriving (deriveShow1, deriveShow2) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) @@ -51,9 +34,7 @@ | (:@:) { tc3 :: b, (##) :: a } deriving ( Show , Generic-#if __GLASGOW_HASKELL__ >= 706 , Generic1-#endif ) -------------------------------------------------------------------------------@@ -64,12 +45,8 @@ data instance TyFamily a b = TyFamilyPrefix { tf1 :: a, tf2 :: b } | (:!:) { tf3 :: b, (###) :: a } deriving ( Show-#if __GLASGOW_HASKELL__ >= 706 , Generic-# if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1-# endif-#endif ) -------------------------------------------------------------------------------@@ -83,35 +60,15 @@ ------------------------------------------------------------------------------- $(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 !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
tests/Derived/TypeFamilies.hs view
@@ -1,4 +1,3 @@--- {-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-}@@ -20,12 +19,7 @@ import Test.QuickCheck (Arbitrary) -{--import Text.Show.Deriving (deriveShow1)-#if defined(NEW_FUNCTOR_CLASSES)-import Text.Show.Deriving (deriveShow2)-#endif--}+import Text.Show.Deriving (deriveShow1, deriveShow2) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) @@ -43,16 +37,11 @@ ------------------------------------------------------------------------------- -{--TODO: Define these once we depend on deriving-compat-0.5.8 as the minimum- $(deriveShow1 ''TyConOverSat)-$(deriveShow1 'TyFamilyOverSat)-#if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2 ''TyConOverSat)++$(deriveShow1 'TyFamilyOverSat) $(deriveShow2 'TyFamilyOverSat)-#endif--} $(deriveTextShow ''TyConOverSat) $(deriveTextShow1 ''TyConOverSat)@@ -61,8 +50,3 @@ $(deriveTextShow 'TyFamilyOverSat) $(deriveTextShow1 'TyFamilyOverSat) $(deriveTextShow2 'TyFamilyOverSat)--{--TODO: Define Generic(1) instances once we depend on generic-deriving-1.13.2-as the minimum--}
tests/Derived/TypeSynonyms.hs view
@@ -1,14 +1,8 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-}--#if __GLASGOW_HASKELL__ >= 706-{-# LANGUAGE DataKinds #-}-#endif--{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Derived.TypeSynonyms@@ -22,20 +16,17 @@ -} module Derived.TypeSynonyms (TyCon(..), TyFamily(..)) where -import Data.Orphans ()+import Control.Monad.Trans.Instances () -import qualified Generics.Deriving.TH as Generics+import Data.Orphans () -import GHC.Generics (Generic)+import GHC.Generics (Generic, Generic1) import Prelude import Test.QuickCheck (Arbitrary) -import Text.Show.Deriving (deriveShow1)-#if defined(NEW_FUNCTOR_CLASSES)-import Text.Show.Deriving (deriveShow2)-#endif+import Text.Show.Deriving (deriveShow1, deriveShow2) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) @@ -56,6 +47,7 @@ deriving ( Arbitrary , Show , Generic+ , Generic1 ) -------------------------------------------------------------------------------@@ -70,45 +62,22 @@ ) deriving ( Arbitrary , Show-#if __GLASGOW_HASKELL__ >= 706 , Generic-#endif+ , Generic1 ) ------------------------------------------------------------------------------- --- 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) -$(Generics.deriveMeta ''TyCon)-$(Generics.deriveRepresentable1 ''TyCon)--#if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 'TyFamily)-#else-$(deriveShow1 'TyFamily) $(deriveShow2 'TyFamily)-#endif $(deriveTextShow 'TyFamily) $(deriveTextShow1 'TyFamily) $(deriveTextShow2 'TyFamily)--$(Generics.deriveMeta 'TyFamily)-$(Generics.deriveRepresentable1 'TyFamily)--#if __GLASGOW_HASKELL__ < 706-$(Generics.deriveRepresentable0 'TyFamily)-#endif
tests/Instances/Control/Concurrent.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Control.Concurrent
tests/Instances/Control/Exception.hs view
@@ -2,7 +2,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Control.Exception@@ -55,10 +55,8 @@ instance Arbitrary AssertionFailed where arbitrary = genericArbitrary -#if MIN_VERSION_base(4,7,0) instance Arbitrary SomeAsyncException where arbitrary = SomeAsyncException <$> (arbitrary :: Gen AsyncException)-#endif deriving instance Bounded AsyncException deriving instance Enum AsyncException@@ -85,16 +83,12 @@ instance Arbitrary BlockedIndefinitelyOnSTM where arbitrary = arbitraryBoundedEnum -#if MIN_VERSION_base(4,8,0) deriving instance Bounded AllocationLimitExceeded deriving instance Enum AllocationLimitExceeded instance Arbitrary AllocationLimitExceeded where arbitrary = arbitraryBoundedEnum-#endif -#if MIN_VERSION_base(4,9,0) deriving instance Arbitrary TypeError-#endif #if MIN_VERSION_base(4,10,0) deriving instance Arbitrary CompactionFailed
tests/Instances/Control/Monad/ST.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Control.Monad.ST
tests/Instances/Data/Char.hs view
@@ -1,4 +1,5 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Data.Char@@ -12,8 +13,10 @@ -} module Instances.Data.Char () where +#if !MIN_VERSION_QuickCheck(2,17,0) import Data.Char (GeneralCategory) import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) instance Arbitrary GeneralCategory where arbitrary = arbitraryBoundedEnum+#endif
tests/Instances/Data/Data.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Data.Data
tests/Instances/Data/Dynamic.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Data.Dynamic
tests/Instances/Data/Floating.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Data.Floating@@ -17,6 +17,8 @@ import Data.Text.Lazy.Builder.RealFloat (FPFormat(..)) import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) +#if !(MIN_VERSION_text(2,0,0)) deriving instance Bounded FPFormat+#endif instance Arbitrary FPFormat where arbitrary = arbitraryBoundedEnum
tests/Instances/Data/Monoid.hs view
@@ -2,7 +2,7 @@ #if MIN_VERSION_base(4,12,0) {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} #endif {-| Module: Instances.Data.Monoid
− tests/Instances/Data/OldTypeable.hs
@@ -1,43 +0,0 @@-{-# LANGUAGE CPP #-}--#if MIN_VERSION_base(4,7,0) && !(MIN_VERSION_base(4,8,0))-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}-#endif--{-|-Module: Instances.Data.OldTypeable-Copyright: (C) 2014-2017 Ryan Scott-License: BSD-style (see the file LICENSE)-Maintainer: Ryan Scott-Stability: Provisional-Portability: GHC--'Arbitrary' instances for data types in the "Data.OldTypeable" module.--}-module Instances.Data.OldTypeable () where--#if MIN_VERSION_base(4,7,0) && !(MIN_VERSION_base(4,8,0))-import Data.OldTypeable.Internal (TyCon(..), TypeRep(..))--import GHC.Generics (Generic)--import Instances.GHC.Fingerprint ()-import Instances.Utils ((<@>))-import Instances.Utils.GenericArbitrary (genericArbitrary)--import Prelude ()-import Prelude.Compat--import Test.QuickCheck (Arbitrary(..))--instance Arbitrary TypeRep where- arbitrary = TypeRep <$> arbitrary <*> arbitrary <@> []--- arbitrary = TypeRep <$> arbitrary <*> arbitrary <*> arbitrary--deriving instance Generic TyCon-instance Arbitrary TyCon where- arbitrary = genericArbitrary-#endif
tests/Instances/Data/Ord.hs view
@@ -1,6 +1,7 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Data.Ord@@ -14,7 +15,9 @@ -} module Instances.Data.Ord () where +#if !MIN_VERSION_QuickCheck(2,17,0) import GHC.Exts (Down(..)) import Test.QuickCheck (Arbitrary) deriving instance Arbitrary a => Arbitrary (Down a)+#endif
tests/Instances/Data/Semigroup.hs view
@@ -1,4 +1,5 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Data.Semigroup@@ -12,9 +13,11 @@ -} module Instances.Data.Semigroup () where -import Data.Semigroup.Compat (Arg(..))+#if !MIN_VERSION_QuickCheck(2,17,0)+import Data.Semigroup (Arg(..)) import Instances.Utils.GenericArbitrary (genericArbitrary) import Test.QuickCheck (Arbitrary(..)) instance (Arbitrary a, Arbitrary b) => Arbitrary (Arg a b) where arbitrary = genericArbitrary+#endif
tests/Instances/Data/Text.hs view
@@ -1,8 +1,7 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-deprecations #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-deprecations #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Data.Text@@ -16,27 +15,20 @@ -} module Instances.Data.Text () where -import Data.Text.Encoding.Error (UnicodeException(..))-import Data.Text.Lazy.Builder (Builder, fromString)--#if MIN_VERSION_text(1,0,0) import Data.Text.Encoding (Decoding(..))-import Instances.Utils ((<@>))-#endif--#if MIN_VERSION_text(1,1,0)+import Data.Text.Encoding.Error (UnicodeException(..)) import Data.Text.Internal.Fusion.Size (Size, exactSize)-import Test.QuickCheck (getNonNegative)-#endif+import Data.Text.Lazy.Builder (Builder, fromString) import GHC.Generics (Generic) +import Instances.Utils ((<@>)) import Instances.Utils.GenericArbitrary (genericArbitrary) import Prelude () import Prelude.Compat -import Test.QuickCheck (Arbitrary(..))+import Test.QuickCheck (Arbitrary(..), getNonNegative) import Test.QuickCheck.Instances () instance Arbitrary Builder where@@ -45,14 +37,10 @@ instance Arbitrary UnicodeException where arbitrary = genericArbitrary -#if MIN_VERSION_text(1,0,0) instance Arbitrary Decoding where arbitrary = Some <$> arbitrary <*> arbitrary <@> undefined-#endif -#if MIN_VERSION_text(1,1,0) instance Arbitrary Size where arbitrary = exactSize . getNonNegative <$> arbitrary-#endif deriving instance Generic UnicodeException
tests/Instances/Data/Tuple.hs view
@@ -1,6 +1,4 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Data.Tuple@@ -14,8 +12,7 @@ -} module Instances.Data.Tuple () where -import Data.Orphans ()-import GHC.Generics (Generic)+import Generics.Deriving.Instances () import Instances.Utils.GenericArbitrary (genericArbitrary) import Test.QuickCheck (Arbitrary(..)) @@ -98,9 +95,3 @@ , Arbitrary o ) => Arbitrary (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where arbitrary = genericArbitrary--deriving instance Generic (a, b, c, d, e, f, g, h, i, j, k)-deriving instance Generic (a, b, c, d, e, f, g, h, i, j, k, l)-deriving instance Generic (a, b, c, d, e, f, g, h, i, j, k, l, m)-deriving instance Generic (a, b, c, d, e, f, g, h, i, j, k, l, m, n)-deriving instance Generic (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
tests/Instances/Data/Type/Coercion.hs view
@@ -1,10 +1,6 @@ {-# LANGUAGE CPP #-}--#if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-}-#endif--{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Data.Type.Coercion@@ -18,7 +14,6 @@ -} module Instances.Data.Type.Coercion () where -#if MIN_VERSION_base(4,7,0) import Data.Coerce (Coercible) import Data.Type.Coercion (Coercion(..)) @@ -26,4 +21,3 @@ instance Coercible a b => Arbitrary (Coercion a b) where arbitrary = arbitraryBoundedEnum-#endif
tests/Instances/Data/Type/Equality.hs view
@@ -1,12 +1,7 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}--#if __GLASGOW_HASKELL__ >= 706-{-# LANGUAGE PolyKinds #-}-#endif--{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Data.Type.Equality@@ -27,7 +22,5 @@ instance a ~ b => Arbitrary (a :~: b) where arbitrary = arbitraryBoundedEnum -#if MIN_VERSION_base(4,9,0) instance a ~~ b => Arbitrary (a :~~: b) where arbitrary = arbitraryBoundedEnum-#endif
tests/Instances/Data/Typeable.hs view
@@ -1,13 +1,9 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-}+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-}--#if __GLASGOW_HASKELL__ >= 706-{-# LANGUAGE PolyKinds #-}-#endif--{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Data.Typeable@@ -23,21 +19,21 @@ #include "MachDeps.h" -#if MIN_VERSION_base(4,9,0) import GHC.Types (TyCon(..), TrName(..), Module(..))-# if WORD_SIZE_IN_BITS < 64+#if MIN_VERSION_base(4,17,0) || WORD_SIZE_IN_BITS < 64 import GHC.Word (Word64(..))-# else-import GHC.Word (Word(..))-# endif #else-import Data.Typeable.Internal (TyCon(..))+import GHC.Word (Word(..)) #endif #if MIN_VERSION_base(4,10,0) import GHC.Exts (Int(..), Ptr(..))-import GHC.Types (KindRep(..), RuntimeRep(..), TypeLitSort(..),- VecCount(..), VecElem(..))+import GHC.Types ( KindRep(..), RuntimeRep(..), TypeLitSort(..)+ , VecCount(..), VecElem(..)+# if MIN_VERSION_base(4,16,0)+ , Levity(..)+# endif+ ) import Type.Reflection (SomeTypeRep(..), Typeable, TypeRep, typeRep) #else import Data.Typeable.Internal (TypeRep(..))@@ -80,8 +76,13 @@ arbitrary = oneof [ VecRep <$> arbitrary <*> arbitrary , pure $ TupleRep [] , pure $ SumRep []+# if MIN_VERSION_base(4,16,0)+ , pure $ BoxedRep Lifted+ , pure $ BoxedRep Unlifted+# else , pure LiftedRep , pure UnliftedRep+# endif , pure IntRep , pure WordRep , pure Int64Rep@@ -100,38 +101,28 @@ instance Arbitrary TypeRep where arbitrary = TypeRep <$> arbitrary <*> arbitrary-# if MIN_VERSION_base(4,8,0) <@> [] <@> []-# else- <@> []-# endif #endif instance Arbitrary TyCon where-#if MIN_VERSION_base(4,9,0) arbitrary = do-# if WORD_SIZE_IN_BITS < 64+#if MIN_VERSION_base(4,17,0) || WORD_SIZE_IN_BITS < 64 W64# w1# <- arbitrary W64# w2# <- arbitrary-# else+#else W# w1# <- arbitrary W# w2# <- arbitrary-# endif-# if MIN_VERSION_base(4,10,0)+#endif+#if MIN_VERSION_base(4,10,0) I# i# <- arbitrary (\a1 a2 a3 -> TyCon w1# w2# a1 a2 i# a3) <$> arbitrary <*> arbitrary <*> arbitrary-# else- TyCon w1# w2# <$> arbitrary <*> arbitrary-# endif #else- arbitrary = TyCon <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary+ TyCon w1# w2# <$> arbitrary <*> arbitrary #endif -#if MIN_VERSION_base(4,9,0) instance Arbitrary TrName where arbitrary = oneof [pure (TrNameS "wat"#), TrNameD <$> arbitrary] instance Arbitrary Module where arbitrary = Module <$> arbitrary <*> arbitrary-#endif
tests/Instances/Foreign/C/Types.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Foreign.C.Types
tests/Instances/Foreign/Ptr.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Foreign.Ptr
tests/Instances/FromStringTextShow.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.FromStringTextShow
tests/Instances/GHC/Conc/Windows.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.GHC.Conc.Windows@@ -14,7 +14,7 @@ -} module Instances.GHC.Conc.Windows () where -#if !defined(__GHCJS__) && defined(mingw32_HOST_OS)+#if !defined(__GHCJS__) && !defined(ghcjs_HOST_OS) && defined(mingw32_HOST_OS) import GHC.Conc.Windows (ConsoleEvent(..)) import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum)
tests/Instances/GHC/Event.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.GHC.Event@@ -14,28 +14,21 @@ -} module Instances.GHC.Event () where -#if !defined(__GHCJS__) && !defined(mingw32_HOST_OS)-import GHC.Event (Event, evtRead, evtWrite)+#if !defined(__GHCJS__) && !defined(ghcjs_HOST_OS) && !defined(mingw32_HOST_OS)+import GHC.Event (Event, Lifetime(..), 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+import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum, oneof) 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
tests/Instances/GHC/Fingerprint.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.GHC.Fingerprint
tests/Instances/GHC/Generics.hs view
@@ -1,11 +1,10 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.GHC.Generics@@ -20,7 +19,7 @@ module Instances.GHC.Generics () where import Data.Orphans ()-import Generics.Deriving.Base+import GHC.Generics import Instances.Utils.GenericArbitrary (genericArbitrary) import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) @@ -45,7 +44,6 @@ instance Arbitrary Associativity where arbitrary = arbitraryBoundedEnum -#if MIN_VERSION_base(4,9,0) instance Arbitrary SourceUnpackedness where arbitrary = arbitraryBoundedEnum @@ -54,10 +52,6 @@ instance Arbitrary DecidedStrictness where arbitrary = arbitraryBoundedEnum-#else-instance Arbitrary Arity where- arbitrary = genericArbitrary-#endif instance Arbitrary (UChar p) where arbitrary = genericArbitrary
tests/Instances/GHC/RTS/Flags.hs view
@@ -1,20 +1,14 @@ {-# LANGUAGE CPP #-}--#if MIN_VERSION_base(4,8,0) {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-# if __GLASGOW_HASKELL__ == 802--- For whatever reason, compiling this module with optimizations on GHC 8.2.2--- triggers a "Simplifier ticks exhausted" panic, and increasing the tick limit--- doesn't seem to help. Moreover, 8.2.2 is the /only/ GHC version I have seen--- this happen on. Life is short, so I'm just going to work around this by--- disabling optimizations on 8.2.2 only.-{-# OPTIONS_GHC -O0 #-}-# endif+{-# OPTIONS_GHC -Wno-orphans #-}+#if __GLASGOW_HASKELL__ == 802+-- See Note [Increased simpl-tick-factor on old GHCs] in TextShow.Data.Complex+{-# OPTIONS_GHC -fsimpl-tick-factor=200 #-} #endif {-|@@ -27,11 +21,8 @@ 'Arbitrary' instances for data types in the "GHC.RTS.Flags" module. -}-module Instances.GHC.RTS.Flags (-#if !(MIN_VERSION_base(4,8,0))- ) where-#else- GiveGCStats'+module Instances.GHC.RTS.Flags+ ( GiveGCStats' , DoCostCentres' , DoHeapProfile' , DoTrace'@@ -39,9 +30,17 @@ import qualified Generics.Deriving.TH as Generics (deriveAll0) import GHC.RTS.Flags+#if MIN_VERSION_base(4,21,0)+import qualified GHC.IO.SubSystem as SubSystem+#elif MIN_VERSION_base(4,15,0)+import qualified GHC.RTS.Flags as SubSystem+#endif import Instances.Utils.GenericArbitrary (genericArbitrary) import Language.Haskell.TH.Lib (conT) import Test.QuickCheck (Arbitrary(..))+#if MIN_VERSION_base(4,21,0)+import Test.QuickCheck (arbitraryBoundedEnum)+#endif import TextShow.TH.Names #if !(MIN_VERSION_base(4,15,0))@@ -65,7 +64,7 @@ #endif #if MIN_VERSION_base(4,15,0)-$(Generics.deriveAll0 ''IoSubSystem)+$(Generics.deriveAll0 ''SubSystem.IoSubSystem) #endif instance Arbitrary RTSFlags where@@ -78,10 +77,16 @@ arbitrary = genericArbitrary #if MIN_VERSION_base(4,15,0)-instance Arbitrary IoSubSystem where+instance Arbitrary SubSystem.IoSubSystem where arbitrary = genericArbitrary #endif +#if MIN_VERSION_base(4,21,0)+deriving instance Bounded IoManagerFlag+instance Arbitrary IoManagerFlag where+ arbitrary = arbitraryBoundedEnum+#endif+ instance Arbitrary MiscFlags where arbitrary = genericArbitrary @@ -100,11 +105,16 @@ instance Arbitrary TickyFlags where arbitrary = genericArbitrary -# if MIN_VERSION_base(4,10,0)+#if MIN_VERSION_base(4,10,0) instance Arbitrary ParFlags where arbitrary = genericArbitrary-# endif+#endif +#if MIN_VERSION_base(4,20,0)+instance Arbitrary HpcFlags where+ arbitrary = genericArbitrary+#endif+ type GiveGCStats' = $(conT giveGCStatsTypeName) type DoCostCentres' = $(conT doCostCentresTypeName) type DoHeapProfile' = $(conT doHeapProfileTypeName)@@ -121,4 +131,3 @@ instance Arbitrary DoTrace' where arbitrary = genericArbitrary-#endif
tests/Instances/GHC/Stack.hs view
@@ -1,11 +1,7 @@-{-# LANGUAGE CPP #-}--#if MIN_VERSION_base(4,8,1)-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-#endif+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.GHC.Stack@@ -19,41 +15,27 @@ -} module Instances.GHC.Stack () where -#if MIN_VERSION_base(4,8,1)-# if MIN_VERSION_base(4,9,0) import GHC.Stack.Types (CallStack(..), SrcLoc(..)) import Instances.Utils ((<@>)) import Test.QuickCheck (oneof)-# else-import GHC.SrcLoc (SrcLoc)-import GHC.Stack (CallStack)-# endif -# if !(MIN_VERSION_base(4,15,0))-import qualified Generics.Deriving.TH as Generics (deriveAll0)-# endif+#if !(MIN_VERSION_base(4,15,0))+import GHC.Generics (Generic)+#endif import Instances.Utils.GenericArbitrary (genericArbitrary) import Test.QuickCheck (Arbitrary(..)) -# if !(MIN_VERSION_base(4,9,0))-$(Generics.deriveAll0 ''CallStack)-# endif-# if !(MIN_VERSION_base(4,15,0))-$(Generics.deriveAll0 ''SrcLoc)-# endif+#if !(MIN_VERSION_base(4,15,0))+deriving instance Generic SrcLoc+#endif instance Arbitrary CallStack where-# if MIN_VERSION_base(4,9,0) arbitrary = oneof [ pure EmptyCallStack , PushCallStack <$> arbitrary <*> arbitrary <@> EmptyCallStack , pure $ FreezeCallStack EmptyCallStack ]-# else- arbitrary = genericArbitrary-# endif instance Arbitrary SrcLoc where arbitrary = genericArbitrary-#endif
tests/Instances/GHC/StaticPtr.hs view
@@ -1,10 +1,6 @@-{-# LANGUAGE CPP #-}--#if MIN_VERSION_base(4,8,0) {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-#endif+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.GHC.StaticPtr@@ -18,7 +14,6 @@ -} module Instances.GHC.StaticPtr () where -#if MIN_VERSION_base(4,8,0) import GHC.Generics (Generic) import GHC.StaticPtr (StaticPtrInfo(..)) @@ -29,4 +24,3 @@ deriving instance Generic StaticPtrInfo instance Arbitrary StaticPtrInfo where arbitrary = genericArbitrary-#endif
tests/Instances/GHC/Stats.hs view
@@ -3,8 +3,8 @@ #if !(MIN_VERSION_base(4,11,0)) {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-deprecations #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-deprecations #-}+{-# OPTIONS_GHC -Wno-orphans #-} #endif {-|
tests/Instances/GHC/TypeLits.hs view
@@ -1,10 +1,6 @@-{-# LANGUAGE CPP #-}--#if MIN_VERSION_base(4,6,0) && !(MIN_VERSION_base(4,7,0))+{-# LANGUAGE CPP #-} {-# LANGUAGE PolyKinds #-}-#endif--{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.GHC.TypeLits@@ -18,20 +14,19 @@ -} module Instances.GHC.TypeLits () where -#if MIN_VERSION_base(4,6,0) import GHC.TypeLits import Prelude () import Prelude.Compat -import Test.QuickCheck (Arbitrary(..))+import Test.QuickCheck (Arbitrary(..), getNonNegative)+import Test.QuickCheck.Instances () -# if MIN_VERSION_base(4,7,0)-import Test.QuickCheck (getNonNegative)-# endif+#if MIN_VERSION_base(4,18,0)+import qualified GHC.TypeNats as TN+import Spec.Utils (GArbitrary(..), Some(..)) #endif -#if MIN_VERSION_base(4,7,0) instance Arbitrary SomeNat where arbitrary = do nat <- getNonNegative <$> arbitrary@@ -41,13 +36,25 @@ 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+#if MIN_VERSION_base(4,16,0)+instance Arbitrary SomeChar where+ arbitrary = someCharVal <$> arbitrary+#endif -instance SingI n => Arbitrary (IsEven n) where- arbitrary = pure $ isEven sing+#if MIN_VERSION_base(4,18,0)+instance GArbitrary SNat where+ garbitrary = do+ n <- arbitrary+ TN.withSomeSNat n (pure . Some)++instance GArbitrary SSymbol where+ garbitrary = do+ s <- arbitrary+ withSomeSSymbol s (pure . Some)++instance GArbitrary SChar where+ garbitrary = do+ c <- arbitrary+ withSomeSChar c (pure . Some) #endif
tests/Instances/Generic.hs view
@@ -6,7 +6,7 @@ #if __GLASGOW_HASKELL__ >= 806 {-# LANGUAGE DerivingVia #-} #endif-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Generic@@ -20,12 +20,7 @@ -} module Instances.Generic () where -import GHC.Generics (Generic)-#if __GLASGOW_HASKELL__ >= 706-import GHC.Generics (Generic1)-#else-import Generics.Deriving.TH (deriveAll1)-#endif+import GHC.Generics (Generic, Generic1) import Instances.Data.Text () import Instances.Utils (GenericExample(..))@@ -50,11 +45,7 @@ arbitrary = genericArbitrary deriving instance Generic (GenericExample a)-#if __GLASGOW_HASKELL__ >= 706 deriving instance Generic1 GenericExample-#else-$(deriveAll1 ''GenericExample)-#endif #if __GLASGOW_HASKELL__ >= 806 deriving via FromGeneric (GenericExample a)
tests/Instances/Options.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Options
tests/Instances/System/IO.hs view
@@ -1,6 +1,7 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.System.IO@@ -24,8 +25,8 @@ import Prelude () import Prelude.Compat -import System.IO (BufferMode(..), IOMode(..), Newline(..), NewlineMode(..),- SeekMode(..), Handle, stdin, stdout, stderr)+import System.IO (BufferMode(..), IOMode(..), SeekMode(..), Handle,+ stdin, stdout, stderr) import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum, oneof) @@ -36,15 +37,21 @@ arbitrary = genericArbitrary deriving instance Bounded IOMode+#if !MIN_VERSION_QuickCheck(2,17,0) instance Arbitrary IOMode where arbitrary = arbitraryBoundedEnum+#endif +#if !MIN_VERSION_QuickCheck(2,17,0) instance Arbitrary BufferMode where arbitrary = genericArbitrary+#endif deriving instance Bounded SeekMode+#if !MIN_VERSION_QuickCheck(2,17,0) instance Arbitrary SeekMode where arbitrary = arbitraryBoundedEnum+#endif deriving instance Bounded CodingProgress deriving instance Enum CodingProgress@@ -56,14 +63,5 @@ instance Arbitrary CodingFailureMode where arbitrary = arbitraryBoundedEnum -deriving instance Bounded Newline-deriving instance Enum Newline-instance Arbitrary Newline where- arbitrary = arbitraryBoundedEnum--instance Arbitrary NewlineMode where- arbitrary = genericArbitrary- deriving instance Generic HandlePosn deriving instance Generic BufferMode-deriving instance Generic NewlineMode
tests/Instances/System/Posix/Types.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.System.Posix.Types
tests/Instances/Text/Read.hs view
@@ -1,14 +1,9 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-}--#if __GLASGOW_HASKELL__ >= 706-{-# LANGUAGE DataKinds #-}-#endif--{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Text.Read@@ -26,28 +21,13 @@ import Instances.Utils.GenericArbitrary (genericArbitrary) import Test.QuickCheck (Arbitrary(..)) import Text.Read (Lexeme(..))--#if MIN_VERSION_base(4,6,0)-import Language.Haskell.TH.Lib (conT)-import TextShow.TH.Names (numberTypeName)-#endif+import Text.Read.Lex (Number) $(Generics.deriveAll0 ''Lexeme)-#if MIN_VERSION_base(4,6,0)-$(Generics.deriveAll0 numberTypeName)-#endif+$(Generics.deriveAll0 ''Number) instance Arbitrary Lexeme where arbitrary = genericArbitrary -#if MIN_VERSION_base(4,6,0)--- NB: Don't attempt to define------ type Number' = $(conT numberTypeName)------ here. Sadly, due to a bizarre GHC 7.6 bug, it'll think it's a recursive--- type synonym and reject it.--instance Arbitrary $(conT numberTypeName) where+instance Arbitrary Number where arbitrary = genericArbitrary-#endif
tests/Instances/Utils/GenericArbitrary.hs view
@@ -22,9 +22,8 @@ -} module Instances.Utils.GenericArbitrary (genericArbitrary) where -import Generics.Deriving.Base- import GHC.Exts (Char(..), Double(..), Float(..), Int(..), Word(..))+import GHC.Generics import Prelude () import Prelude.Compat
tests/Spec/BuilderSpec.hs view
@@ -12,7 +12,7 @@ import Instances.Data.Text () -import Test.Hspec (Spec, describe, hspec, parallel)+import Test.Hspec (Expectation, Spec, describe, hspec, parallel, shouldBe) import Test.Hspec.QuickCheck (prop) import TextShow (Builder, fromString, fromText, lengthB,@@ -22,24 +22,24 @@ main = hspec spec -- | Verifies 'lengthB' and 'length' produce the same output.-prop_lengthB :: String -> Bool-prop_lengthB s = fromIntegral (lengthB $ fromString s) == length s+prop_lengthB :: String -> Expectation+prop_lengthB s = fromIntegral (lengthB $ fromString s) `shouldBe` length s -- | Verifies @fromText . toText = id@.-prop_toText :: Builder -> Bool-prop_toText b = fromText (toText b) == b+prop_toText :: Builder -> Expectation+prop_toText b = fromText (toText b) `shouldBe` b -- | Verifies @fromString . toString = id@.-prop_toString :: Builder -> Bool-prop_toString b = fromString (toString b) == b+prop_toString :: Builder -> Expectation+prop_toString b = fromString (toString b) `shouldBe` b -- | Verifies 'unlinesB' and 'unlines' produce the same output.-prop_unlinesB :: [String] -> Bool-prop_unlinesB strs = unlinesB (map fromString strs) == fromString (unlines strs)+prop_unlinesB :: [String] -> Expectation+prop_unlinesB strs = unlinesB (map fromString strs) `shouldBe` fromString (unlines strs) -- | Verifies 'unwordsB' and 'unwords' produce the same output.-prop_unwordsB :: [String] -> Bool-prop_unwordsB strs = unwordsB (map fromString strs) == fromString (unwords strs)+prop_unwordsB :: [String] -> Expectation+prop_unwordsB strs = unwordsB (map fromString strs) `shouldBe` fromString (unwords strs) spec :: Spec spec = parallel $ do
tests/Spec/Control/ApplicativeSpec.hs view
@@ -14,9 +14,7 @@ import Control.Monad.Trans.Instances () import Data.Orphans ()-import Data.Proxy.Compat (Proxy(..))--import Generics.Deriving.Instances ()+import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShowSpec, matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec)
tests/Spec/Control/ConcurrentSpec.hs view
@@ -12,7 +12,7 @@ import Control.Concurrent (myThreadId) -import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import GHC.Conc (BlockReason, ThreadStatus)
tests/Spec/Control/ExceptionSpec.hs view
@@ -16,7 +16,7 @@ #if MIN_VERSION_base(4,11,0) import Control.Exception.Base (FixIOException) #endif-import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Instances.Control.Exception () import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel)@@ -36,10 +36,8 @@ matchesTextShowSpec (Proxy :: Proxy ArrayException) describe "AssertionFailed" $ matchesTextShowSpec (Proxy :: Proxy AssertionFailed)-#if MIN_VERSION_base(4,7,0) describe "SomeAsyncException" $ matchesTextShowSpec (Proxy :: Proxy SomeAsyncException)-#endif describe "AsyncException" $ matchesTextShowSpec (Proxy :: Proxy AsyncException) describe "NonTermination" $@@ -50,14 +48,10 @@ matchesTextShowSpec (Proxy :: Proxy BlockedIndefinitelyOnMVar) describe "BlockedIndefinitelyOnSTM" $ matchesTextShowSpec (Proxy :: Proxy BlockedIndefinitelyOnSTM)-#if MIN_VERSION_base(4,8,0) describe "AllocationLimitExceeded" $ matchesTextShowSpec (Proxy :: Proxy AllocationLimitExceeded)-#endif-#if MIN_VERSION_base(4,9,0) describe "TypeError" $ matchesTextShowSpec (Proxy :: Proxy TypeError)-#endif #if MIN_VERSION_base(4,10,0) describe "CompactionFailed" $ matchesTextShowSpec (Proxy :: Proxy CompactionFailed)
tests/Spec/Control/Monad/STSpec.hs view
@@ -1,7 +1,7 @@ module Spec.Control.Monad.STSpec (main, spec) where import Control.Monad.ST-import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Instances.Control.Monad.ST () import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel)
+ tests/Spec/Data/Array/ByteSpec.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE CPP #-}++{-|+Module: Spec.Data.Array.ByteSpec+Copyright: (C) 2022 Ryan Scott+License: BSD-style (see the file LICENSE)+Maintainer: Ryan Scott+Stability: Provisional+Portability: GHC++@hspec@ tests for 'ByteArray' from the "Data.Array.Byte" module.+-}+module Spec.Data.Array.ByteSpec (main, spec) where++import Prelude ()+import Prelude.Compat++import Test.Hspec (Spec, hspec, parallel)+import Test.QuickCheck.Instances ()++#if MIN_VERSION_base(4,17,0)+import Data.Array.Byte (ByteArray)+import Data.Proxy (Proxy(..))++import Spec.Utils (matchesTextShowSpec)++import Test.Hspec (describe)+#endif++main :: IO ()+main = hspec spec++spec :: Spec+spec = parallel $ do+#if MIN_VERSION_base(4,17,0)+ describe "ByteArray" $+ matchesTextShowSpec (Proxy :: Proxy ByteArray)+#else+ pure ()+#endif
tests/Spec/Data/ArraySpec.hs view
@@ -18,10 +18,10 @@ import Test.Hspec (Spec, hspec, parallel) import Test.QuickCheck.Instances () -#if !defined(mingw32_HOST_OS) && MIN_VERSION_text(1,0,0)+#if !defined(mingw32_HOST_OS) import Data.Array (Array) import Data.Array.Unboxed (UArray)-import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShowSpec) @@ -33,7 +33,7 @@ spec :: Spec spec = parallel $ do-#if !defined(mingw32_HOST_OS) && MIN_VERSION_text(1,0,0)+#if !defined(mingw32_HOST_OS) -- TODO: Figure out why these tests diverge on Windows describe "Array Int Int" $ matchesTextShowSpec (Proxy :: Proxy (Array Int Int))
tests/Spec/Data/BoolSpec.hs view
@@ -12,7 +12,7 @@ -} module Spec.Data.BoolSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShowSpec, genericTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel)
tests/Spec/Data/ByteStringSpec.hs view
@@ -13,7 +13,7 @@ import qualified Data.ByteString as BS (ByteString) import qualified Data.ByteString.Lazy as BL (ByteString) import Data.ByteString.Short (ShortByteString)-import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShowSpec)
tests/Spec/Data/CharSpec.hs view
@@ -12,7 +12,7 @@ import Data.Array (elems) import Data.Char (GeneralCategory)-import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import GHC.Show (asciiTab)
tests/Spec/Data/ComplexSpec.hs view
@@ -11,7 +11,7 @@ module Spec.Data.ComplexSpec (main, spec) where import Data.Complex (Complex)-import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShowSpec)
tests/Spec/Data/DataSpec.hs view
@@ -11,7 +11,7 @@ module Spec.Data.DataSpec (main, spec) where import Data.Data (Constr, ConstrRep, DataRep, DataType, Fixity)-import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Instances.Data.Data ()
tests/Spec/Data/DynamicSpec.hs view
@@ -11,7 +11,7 @@ module Spec.Data.DynamicSpec (main, spec) where import Data.Dynamic (Dynamic)-import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Instances.Data.Dynamic ()
tests/Spec/Data/EitherSpec.hs view
@@ -10,8 +10,7 @@ -} module Spec.Data.EitherSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))-import Generics.Deriving.Instances ()+import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel)
tests/Spec/Data/FixedSpec.hs view
@@ -11,11 +11,11 @@ module Spec.Data.FixedSpec (main, spec) where import Data.Fixed (Fixed, E0, E1, E2, E3, E6, E9, E12, showFixed)-import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShowSpec) -import Test.Hspec (Spec, describe, hspec, parallel)+import Test.Hspec (Expectation, Spec, describe, hspec, parallel, shouldBe) import Test.Hspec.QuickCheck (prop) import TextShow (fromString)@@ -44,5 +44,5 @@ 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+prop_showFixed :: Bool -> Fixed E12 -> Expectation+prop_showFixed b f = fromString (showFixed b f) `shouldBe` showbFixed b f
tests/Spec/Data/FloatingSpec.hs view
@@ -12,13 +12,13 @@ -} module Spec.Data.FloatingSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Data.Text.Lazy.Builder.RealFloat (FPFormat) import Instances.Data.Floating () -import Numeric.Compat (showEFloat, showFFloat, showGFloat,- showFFloatAlt, showGFloatAlt)+import Numeric (showEFloat, showFFloat, showGFloat,+ showFFloatAlt, showGFloatAlt) import Prelude () import Prelude.Compat
tests/Spec/Data/Functor/ComposeSpec.hs view
@@ -13,7 +13,7 @@ import Control.Monad.Trans.Instances () import Data.Functor.Compose (Compose)-import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShow1Spec)
tests/Spec/Data/Functor/IdentitySpec.hs view
@@ -13,7 +13,7 @@ import Control.Monad.Trans.Instances () import Data.Functor.Identity (Identity)-import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShow1Spec)
tests/Spec/Data/Functor/ProductSpec.hs view
@@ -13,7 +13,7 @@ import Control.Monad.Trans.Instances () import Data.Functor.Product (Product)-import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShow1Spec)
tests/Spec/Data/Functor/SumSpec.hs view
@@ -13,7 +13,7 @@ import Control.Monad.Trans.Instances () import Data.Functor.Sum (Sum)-import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShow1Spec)
tests/Spec/Data/IntegralSpec.hs view
@@ -13,7 +13,7 @@ module Spec.Data.IntegralSpec (main, spec) where import Data.Int (Int8, Int16, Int32, Int64)-import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Data.Word (Word8, Word16, Word32, Word64) import Prelude ()@@ -23,14 +23,13 @@ import Test.Hspec (Spec, describe, hspec, parallel) -#if !defined(mingw32_HOST_OS) && MIN_VERSION_text(1,0,0)-import Control.Applicative (liftA2)-+#if !defined(mingw32_HOST_OS) import Data.Char (intToDigit) import Numeric (showIntAtBase) import Test.QuickCheck (Gen, arbitrary, getNonNegative, suchThat)+import Test.Hspec (Expectation, shouldBe) import Test.Hspec.QuickCheck (prop) import TextShow (fromString)@@ -64,17 +63,17 @@ matchesTextShowSpec (Proxy :: Proxy Word32) describe "Word64" $ matchesTextShowSpec (Proxy :: Proxy Word64)-#if !defined(mingw32_HOST_OS) && MIN_VERSION_text(1,0,0)+#if !defined(mingw32_HOST_OS) -- 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+#if !defined(mingw32_HOST_OS)+prop_showIntAtBase :: Gen Expectation prop_showIntAtBase = do- base <- arbitrary `suchThat` liftA2 (&&) (> 1) (<= 16)+ base <- arbitrary `suchThat` \b -> 1 < b && b <= 16 i <- getNonNegative <$> arbitrary :: Gen Int- pure $ fromString (showIntAtBase base intToDigit i "") == showbIntAtBase base intToDigit i+ pure $ fromString (showIntAtBase base intToDigit i "") `shouldBe` showbIntAtBase base intToDigit i #endif
tests/Spec/Data/List/NonEmptySpec.hs view
@@ -10,8 +10,8 @@ -} module Spec.Data.List.NonEmptySpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))-import Data.List.NonEmpty.Compat (NonEmpty)+import Data.Proxy (Proxy(..))+import Data.List.NonEmpty (NonEmpty) import Data.Orphans () import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel)
tests/Spec/Data/ListSpec.hs view
@@ -10,11 +10,11 @@ -} module Spec.Data.ListSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShowSpec) -import Test.Hspec (Spec, describe, hspec, parallel)+import Test.Hspec (Expectation, Spec, describe, hspec, parallel, shouldBe) import Test.Hspec.QuickCheck (prop) import Text.Show (showListWith)@@ -36,5 +36,5 @@ 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+prop_showListWith :: String -> Expectation+prop_showListWith str = fromString (showListWith shows str "") `shouldBe` showbListWith showb str
tests/Spec/Data/MaybeSpec.hs view
@@ -11,7 +11,7 @@ module Spec.Data.MaybeSpec (main, spec) where import Data.Orphans ()-import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec)
tests/Spec/Data/MonoidSpec.hs view
@@ -13,9 +13,7 @@ module Spec.Data.MonoidSpec (main, spec) where import Data.Monoid-import Data.Proxy.Compat (Proxy(..))--import Generics.Deriving.Instances ()+import Data.Proxy (Proxy(..)) import Instances.Data.Monoid () @@ -68,14 +66,12 @@ matchesTextShowSpec p genericTextShowSpec p genericTextShow1Spec p-#if MIN_VERSION_base(4,8,0) describe "Alt Maybe Int" $ do let p :: Proxy (Alt Maybe Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p genericTextShow1Spec p-#endif #if MIN_VERSION_base(4,12,0) describe "Ap Maybe Int" $ do let p :: Proxy (Ap Maybe Int)
− tests/Spec/Data/OldTypeableSpec.hs
@@ -1,47 +0,0 @@-{-# LANGUAGE CPP #-}--#if MIN_VERSION_base(4,7,0) && !(MIN_VERSION_base(4,8,0))-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}-#endif--{-|-Module: Spec.Data.OldTypeableSpec-Copyright: (C) 2014-2017 Ryan Scott-License: BSD-style (see the file LICENSE)-Maintainer: Ryan Scott-Stability: Provisional-Portability: GHC--@hspec@ tests for data types in the "Data.OldTypeable" module.--}-module Spec.Data.OldTypeableSpec (main, spec) where--import Instances.Data.OldTypeable ()--import Prelude ()-import Prelude.Compat--import Test.Hspec (Spec, hspec, parallel)--#if MIN_VERSION_base(4,7,0) && !(MIN_VERSION_base(4,8,0))-import Data.OldTypeable (TyCon, TypeRep)-import Data.Proxy.Compat (Proxy(..))--import Spec.Utils (matchesTextShowSpec)--import Test.Hspec (describe)-#endif--main :: IO ()-main = hspec spec--spec :: Spec-spec = parallel $ do-#if MIN_VERSION_base(4,7,0) && !(MIN_VERSION_base(4,8,0))- describe "TypeRep" $- matchesTextShowSpec (Proxy :: Proxy TypeRep)- describe "TyCon" $- matchesTextShowSpec (Proxy :: Proxy TyCon)-#else- pure ()-#endif
tests/Spec/Data/OrdSpec.hs view
@@ -11,9 +11,7 @@ module Spec.Data.OrdSpec (main, spec) where import Data.Orphans ()-import Data.Proxy.Compat (Proxy(..))--import Generics.Deriving.Instances ()+import Data.Proxy (Proxy(..)) import GHC.Exts (Down)
tests/Spec/Data/ProxySpec.hs view
@@ -10,9 +10,7 @@ -} module Spec.Data.ProxySpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))--import Generics.Deriving.Base ()+import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShowSpec, genericTextShowSpec)
tests/Spec/Data/RatioSpec.hs view
@@ -10,7 +10,7 @@ -} module Spec.Data.RatioSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Data.Ratio (Ratio) import Spec.Utils (matchesTextShowSpec)
tests/Spec/Data/SemigroupSpec.hs view
@@ -10,8 +10,8 @@ -} module Spec.Data.SemigroupSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))-import Data.Semigroup.Compat (Min, Max, First, Last, WrappedMonoid, Arg)+import Data.Proxy (Proxy(..))+import Data.Semigroup (Min, Max, First, Last, WrappedMonoid, Arg) import Instances.Data.Semigroup ()
tests/Spec/Data/TextSpec.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE CPP #-}- {-| Module: Spec.Data.TextSpec Copyright: (C) 2014-2017 Ryan Scott@@ -12,7 +10,7 @@ -} module Spec.Data.TextSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Instances.Data.Text () @@ -22,13 +20,9 @@ import qualified Data.Text as TS import qualified Data.Text as TL-#if MIN_VERSION_text(1,0,0) import Data.Text.Encoding (Decoding)-#endif import Data.Text.Encoding.Error (UnicodeException)-#if MIN_VERSION_text(1,1,0) import Data.Text.Internal.Fusion.Size (Size)-#endif import Data.Text.Lazy.Builder (Builder) main :: IO ()@@ -44,11 +38,7 @@ matchesTextShowSpec (Proxy :: Proxy TL.Text) describe "UnicodeException" $ matchesTextShowSpec (Proxy :: Proxy UnicodeException)-#if MIN_VERSION_text(1,0,0) describe "Decoding" $ matchesTextShowSpec (Proxy :: Proxy Decoding)-#endif-#if MIN_VERSION_text(1,1,0) describe "Size" $ matchesTextShowSpec (Proxy :: Proxy Size)-#endif
tests/Spec/Data/TupleSpec.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ {-| Module: Spec.Data.TupleSpec Copyright: (C) 2014-2017 Ryan Scott@@ -10,12 +12,15 @@ -} module Spec.Data.TupleSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))-import Generics.Deriving.Instances ()+import Data.Proxy (Proxy(..))+#if MIN_VERSION_ghc_prim(0,7,0) && MIN_VERSION_base(4,16,0)+import GHC.Tuple (Solo)+#endif import Instances.Data.Tuple () import Spec.Utils (matchesTextShowSpec, matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel)+import Test.QuickCheck.Instances () main :: IO () main = hspec spec@@ -79,3 +84,10 @@ matchesTextShowSpec (Proxy :: Proxy (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)) describe "(Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)" $ do matchesTextShowSpec (Proxy :: Proxy (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int))+#if MIN_VERSION_ghc_prim(0,7,0) && MIN_VERSION_base(4,16,0)+ describe "Solo Int" $ do+ let p :: Proxy (Solo Int)+ p = Proxy+ matchesTextShowSpec p+ matchesTextShow1Spec p+#endif
tests/Spec/Data/Type/CoercionSpec.hs view
@@ -12,31 +12,23 @@ -} module Spec.Data.Type.CoercionSpec (main, spec) where +import Data.Monoid (All(..))+import Data.Proxy (Proxy(..))+import Data.Type.Coercion (Coercion)+ import Instances.Data.Type.Coercion () import Prelude () import Prelude.Compat -import Test.Hspec (Spec, hspec, parallel)--#if MIN_VERSION_base(4,7,0)-import Data.Monoid (All(..))-import Data.Proxy.Compat (Proxy(..))-import Data.Type.Coercion (Coercion)- import Spec.Utils (matchesTextShowSpec) -import Test.Hspec (describe)-#endif+import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel $-#if MIN_VERSION_base(4,7,0) describe "Coercion All Bool" $ matchesTextShowSpec (Proxy :: Proxy (Coercion All Bool))-#else- pure ()-#endif
tests/Spec/Data/Type/EqualitySpec.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE TypeOperators #-} {-|@@ -13,7 +12,7 @@ -} module Spec.Data.Type.EqualitySpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Data.Type.Equality.Compat import Instances.Data.Type.Equality ()@@ -33,7 +32,5 @@ spec = parallel $ do describe "Int :~: Int" $ matchesTextShowSpec (Proxy :: Proxy (Int :~: Int))-# if MIN_VERSION_base(4,9,0) describe "Int :~~: Int" $ matchesTextShowSpec (Proxy :: Proxy (Int :~~: Int))-# endif
tests/Spec/Data/TypeableSpec.hs view
@@ -1,8 +1,5 @@ {-# LANGUAGE CPP #-}--#if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-}-#endif {-| Module: Spec.Data.TypeableSpec@@ -16,12 +13,10 @@ -} module Spec.Data.TypeableSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Data.Typeable (TyCon) -#if MIN_VERSION_base(4,9,0) import GHC.Types (TrName, Module)-#endif #if MIN_VERSION_base(4,10,0) import Data.Kind (Type)@@ -43,18 +38,18 @@ spec = parallel $ do describe "TyCon" $ matchesTextShowSpec (Proxy :: Proxy TyCon)-#if MIN_VERSION_base(4,9,0) describe "TrName" $ matchesTextShowSpec (Proxy :: Proxy TrName) describe "Module" $ matchesTextShowSpec (Proxy :: Proxy Module)-#endif #if MIN_VERSION_base(4,10,0) describe "SomeTypeRep" $ matchesTextShowSpec (Proxy :: Proxy SomeTypeRep) describe "TypeRep" $ do describe "TypeRep Type" $ matchesTextShowSpec (Proxy :: Proxy (TypeRep Type))+ describe "TypeRep []" $+ matchesTextShowSpec (Proxy :: Proxy (TypeRep [])) describe "TypeRep [Int]" $ matchesTextShowSpec (Proxy :: Proxy (TypeRep [Int])) describe "TypeRep '[Int]" $@@ -65,6 +60,10 @@ matchesTextShowSpec (Proxy :: Proxy (TypeRep '(Int, Int))) describe "TypeRep (Int -> Int)" $ matchesTextShowSpec (Proxy :: Proxy (TypeRep (Int -> Int)))+ describe "TypeRep ((,) Int)" $+ matchesTextShowSpec (Proxy :: Proxy (TypeRep ((,) Int)))+ describe "TypeRep ('(,) Int)" $+ matchesTextShowSpec (Proxy :: Proxy (TypeRep ('(,) Int))) describe "TypeRep (Either Int)" $ matchesTextShowSpec (Proxy :: Proxy (TypeRep (Either Int))) #else
tests/Spec/Data/VersionSpec.hs view
@@ -1,11 +1,11 @@ module Spec.Data.VersionSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Data.Version (Version, showVersion) import Spec.Utils (matchesTextShowSpec) -import Test.Hspec (Spec, describe, hspec, parallel)+import Test.Hspec (Expectation, Spec, describe, hspec, parallel, shouldBe) import Test.Hspec.QuickCheck (prop) import TextShow (fromString)@@ -22,5 +22,5 @@ prop "has the same output as showVersion" prop_showVersion -- | Verifies 'showVersion' and 'showbVersion' generate the same output.-prop_showVersion :: Version -> Bool-prop_showVersion v = fromString (showVersion v) == showbVersion v+prop_showVersion :: Version -> Expectation+prop_showVersion v = fromString (showVersion v) `shouldBe` showbVersion v
tests/Spec/Derived/DataFamiliesSpec.hs view
@@ -1,8 +1,4 @@-{-# LANGUAGE CPP #-}--#if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-}-#endif {-| Module: Spec.Derived.DataFamiliesSpec@@ -16,26 +12,18 @@ -} module Spec.Derived.DataFamiliesSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) -import Derived.DataFamilies (NotAllShow)+import Derived.DataFamilies (NotAllShow, KindDistinguished, NullaryData) import Prelude () import Prelude.Compat -import Spec.Utils (matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec)+import Spec.Utils ( matchesTextShowSpec, matchesTextShow1Spec+ , genericTextShowSpec, genericTextShow1Spec ) import Test.Hspec (Spec, describe, hspec, parallel) -#if __GLASGOW_HASKELL__ >= 706-import Derived.DataFamilies (KindDistinguished)-#endif--#if __GLASGOW_HASKELL__ >= 708-import Derived.DataFamilies (NullaryData)-import Spec.Utils (matchesTextShowSpec)-#endif- main :: IO () main = hspec spec @@ -47,7 +35,6 @@ matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p-#if __GLASGOW_HASKELL__ >= 706 describe "KindDistinguished '() Int Int" $ do let p :: Proxy (KindDistinguished '() Int Int) p = Proxy@@ -60,11 +47,8 @@ matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p-#endif-#if __GLASGOW_HASKELL__ >= 708 describe "NullaryData" $ do let p :: Proxy NullaryData p = Proxy matchesTextShowSpec p genericTextShowSpec p-#endif
tests/Spec/Derived/DatatypeContextsSpec.hs view
@@ -10,7 +10,7 @@ -} module Spec.Derived.DatatypeContextsSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Derived.DatatypeContexts import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel)
tests/Spec/Derived/ExistentialQuantificationSpec.hs view
@@ -10,7 +10,7 @@ -} module Spec.Derived.ExistentialQuantificationSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Derived.ExistentialQuantification import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel)
tests/Spec/Derived/InfixSpec.hs view
@@ -10,7 +10,7 @@ -} module Spec.Derived.InfixSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Derived.Infix import Spec.Utils (matchesTextShowSpec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel)
tests/Spec/Derived/MagicHashSpec.hs view
@@ -1,5 +1,9 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-}+#if __GLASGOW_HASKELL__ == 800+-- See Note [Increased simpl-tick-factor on old GHCs] in TextShow.Data.Complex+{-# OPTIONS_GHC -fsimpl-tick-factor=250 #-}+#endif {-| Module: Spec.Derived.MagicHashSpec@@ -13,7 +17,7 @@ -} module Spec.Derived.MagicHashSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Derived.MagicHash import Spec.Utils import Test.Hspec (Spec, describe, hspec, parallel)
tests/Spec/Derived/PolyKindsSpec.hs view
@@ -10,7 +10,7 @@ -} module Spec.Derived.PolyKindsSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Derived.PolyKinds import Spec.Utils (matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel)
tests/Spec/Derived/RankNTypesSpec.hs view
@@ -10,7 +10,7 @@ -} module Spec.Derived.RankNTypesSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Derived.RankNTypes import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel)
tests/Spec/Derived/RecordsSpec.hs view
@@ -1,3 +1,9 @@+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ == 800+-- See Note [Increased simpl-tick-factor on old GHCs] in TextShow.Data.Complex+{-# OPTIONS_GHC -fsimpl-tick-factor=200 #-}+#endif+ {-| Module: Spec.Derived.RecordsSpec Copyright: (C) 2014-2017 Ryan Scott@@ -10,7 +16,7 @@ -} module Spec.Derived.RecordsSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Derived.Records import Spec.Utils (matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel)
tests/Spec/Derived/TypeFamiliesSpec.hs view
@@ -10,33 +10,23 @@ -} module Spec.Derived.TypeFamiliesSpec (main, spec) where -{--import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Derived.TypeFamilies--} import Prelude () import Prelude.Compat -{- import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel)--}-import Test.Hspec (Spec, hspec) main :: IO () main = hspec spec spec :: Spec-spec = pure ()-{--TODO: Uncomment once we depend on deriving-compat-0.5.8 as the minimum- spec = parallel $ do describe "TyConOverSat Int Int" $ matchesTextShow1Spec (Proxy :: Proxy (TyConOverSat Int Int)) describe "TyFamilyOverSat Int Int" $ matchesTextShow1Spec (Proxy :: Proxy (TyFamilyOverSat Int Int))--}
tests/Spec/Derived/TypeSynonymsSpec.hs view
@@ -10,7 +10,7 @@ -} module Spec.Derived.TypeSynonymsSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Derived.TypeSynonyms import Spec.Utils (matchesTextShowSpec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel)
tests/Spec/Foreign/C/TypesSpec.hs view
@@ -12,7 +12,7 @@ -} module Spec.Foreign.C.TypesSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Foreign.C.Types import Instances.Foreign.C.Types () import Spec.Utils (matchesTextShowSpec)
tests/Spec/Foreign/PtrSpec.hs view
@@ -10,7 +10,7 @@ -} module Spec.Foreign.PtrSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Foreign.ForeignPtr (newForeignPtr_) import Foreign.Ptr (FunPtr, IntPtr, Ptr, WordPtr)
tests/Spec/FromStringTextShowSpec.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE CPP #-}- {-| Module: Spec.FromStringTextShowSpec Copyright: (C) 2014-2017 Ryan Scott@@ -12,17 +10,14 @@ -} module Spec.FromStringTextShowSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Instances.FromStringTextShow ()-import Spec.Utils (matchesTextShowSpec, matchesTextShow1Spec)+import Spec.Utils (matchesTextShowSpec, matchesTextShow1Spec,+ matchesTextShow2Spec) import Test.Hspec (Spec, describe, hspec, parallel)-import TextShow (FromStringShow(..), FromTextShow(..))--#if defined(NEW_FUNCTOR_CLASSES)-import Spec.Utils (matchesTextShow2Spec)-import TextShow (FromStringShow1(..), FromStringShow2(..),+import TextShow (FromStringShow(..), FromTextShow(..),+ FromStringShow1(..), FromStringShow2(..), FromTextShow1(..), FromTextShow2(..))-#endif main :: IO () main = hspec spec@@ -33,43 +28,31 @@ let p :: Proxy (FromStringShow Int) p = Proxy matchesTextShowSpec p- matchesTextShow1Spec p describe "FromStringShow String" $ do let p :: Proxy (FromStringShow String) p = Proxy matchesTextShowSpec p- matchesTextShow1Spec p describe "FromTextShow Int" $ do let p :: Proxy (FromTextShow Int) p = Proxy matchesTextShowSpec p- matchesTextShow1Spec p describe "FromTextShow String" $ do let p :: Proxy (FromTextShow String) p = Proxy matchesTextShowSpec p- matchesTextShow1Spec p-#if defined(NEW_FUNCTOR_CLASSES) describe "FromStringShow1 Maybe Int" $ do let p :: Proxy (FromStringShow1 Maybe Int) p = Proxy- matchesTextShowSpec p matchesTextShow1Spec p describe "FromTextShow1 Maybe Int" $ do let p :: Proxy (FromTextShow1 Maybe Int) p = Proxy- matchesTextShowSpec p matchesTextShow1Spec p describe "FromStringShow2 Either Char Int" $ do let p :: Proxy (FromStringShow2 Either Char Int) p = Proxy- matchesTextShowSpec p- matchesTextShow1Spec p matchesTextShow2Spec p describe "FromTextShow2 Either Char Int" $ do let p :: Proxy (FromTextShow2 Either Char Int) p = Proxy- matchesTextShowSpec p- matchesTextShow1Spec p matchesTextShow2Spec p-#endif
tests/Spec/FunctionsSpec.hs view
@@ -10,7 +10,7 @@ -} module Spec.FunctionsSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) import Text.Show.Functions ()
tests/Spec/GHC/Conc/WindowsSpec.hs view
@@ -19,8 +19,8 @@ import Test.Hspec (Spec, hspec, parallel) -#if !defined(__GHCJS__) && defined(mingw32_HOST_OS)-import Data.Proxy.Compat (Proxy(..))+#if !defined(__GHCJS__) && !defined(ghcjs_HOST_OS) && defined(mingw32_HOST_OS)+import Data.Proxy (Proxy(..)) import GHC.Conc.Windows (ConsoleEvent) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe)@@ -31,7 +31,7 @@ spec :: Spec spec = parallel $-#if !defined(__GHCJS__) && defined(mingw32_HOST_OS)+#if !defined(__GHCJS__) && !defined(ghcjs_HOST_OS) && defined(mingw32_HOST_OS) describe "ConsoleEvent" $ matchesTextShowSpec (Proxy :: Proxy ConsoleEvent) #else
tests/Spec/GHC/EventSpec.hs view
@@ -19,13 +19,10 @@ import Test.Hspec (Spec, hspec, parallel) -#if !defined(__GHCJS__) && !defined(mingw32_HOST_OS)-import Data.Proxy.Compat (Proxy(..))+#if !defined(__GHCJS__) && !defined(ghcjs_HOST_OS) && !defined(mingw32_HOST_OS)+import Data.Proxy (Proxy(..)) -import GHC.Event (Event)-# if MIN_VERSION_base(4,8,1)-import GHC.Event (Lifetime)-#endif+import GHC.Event (Event, Lifetime) import Spec.Utils (matchesTextShowSpec) @@ -38,15 +35,13 @@ spec :: Spec spec = parallel $ do-#if !defined(__GHCJS__) && !defined(mingw32_HOST_OS)+#if !defined(__GHCJS__) && !defined(ghcjs_HOST_OS) && !defined(mingw32_HOST_OS) describe "Event" $ matchesTextShowSpec (Proxy :: Proxy Event) -- describe "FdKey" $ -- matchesTextShowSpec (Proxy :: Proxy FdKey)-# if MIN_VERSION_base(4,8,1) describe "Lifetime" $ matchesTextShowSpec (Proxy :: Proxy Lifetime)-# endif #else pure () #endif
tests/Spec/GHC/FingerprintSpec.hs view
@@ -10,7 +10,7 @@ -} module Spec.GHC.FingerprintSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Data.Orphans () import GHC.Fingerprint.Type (Fingerprint)
tests/Spec/GHC/GenericsSpec.hs view
@@ -1,9 +1,5 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE TypeOperators #-}--#if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-}-#endif+{-# LANGUAGE TypeOperators #-} {-| Module: Spec.GHC.GenericsSpec@@ -18,18 +14,14 @@ module Spec.GHC.GenericsSpec (main, spec) where import Data.Orphans ()-import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) -import Generics.Deriving.Base ( U1, Par1, Rec1, K1, M1, (:+:), (:*:), (:.:)- , UChar, UDouble, UFloat, UInt, UWord- , Fixity, Associativity-#if MIN_VERSION_base(4,9,0)- , Meta(MetaData), SourceUnpackedness- , SourceStrictness, DecidedStrictness-#else- , Arity-#endif- )+import GHC.Generics ( U1, Par1, Rec1, K1, M1, (:+:), (:*:), (:.:)+ , UChar, UDouble, UFloat, UInt, UWord+ , Fixity, Associativity+ , Meta(MetaData), SourceUnpackedness+ , SourceStrictness, DecidedStrictness+ ) import Instances.GHC.Generics () @@ -40,18 +32,11 @@ 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@@ -64,7 +49,6 @@ p = Proxy matchesTextShowSpec p genericTextShowSpec p-#if MIN_VERSION_base(4,9,0) describe "SourceUnpackedness" $ do let p :: Proxy SourceUnpackedness p = Proxy@@ -80,13 +64,6 @@ p = Proxy matchesTextShowSpec p genericTextShowSpec p-#else- describe "Arity" $ do- let p :: Proxy Arity- p = Proxy- matchesTextShowSpec p- genericTextShowSpec p-#endif describe "U1 Int" $ do let p :: Proxy (U1 Int) p = Proxy
tests/Spec/GHC/RTS/FlagsSpec.hs view
@@ -12,35 +12,37 @@ -} module Spec.GHC.RTS.FlagsSpec (main, spec) where -import Prelude ()-import Prelude.Compat--import Test.Hspec (Spec, hspec, parallel)+import Data.Proxy (Proxy(..)) -#if MIN_VERSION_base(4,8,0)-import Data.Proxy.Compat (Proxy(..)) import GHC.RTS.Flags+ import Instances.GHC.RTS.Flags++import Prelude ()+import Prelude.Compat+ import Spec.Utils (matchesTextShowSpec)-import Test.Hspec (describe)-#endif +import Test.Hspec (Spec, describe, hspec, parallel)+ main :: IO () main = hspec spec spec :: Spec spec = parallel $ do-#if MIN_VERSION_base(4,8,0) describe "RTSFlags" $ matchesTextShowSpec (Proxy :: Proxy RTSFlags) describe "GCFlags" $ matchesTextShowSpec (Proxy :: Proxy GCFlags) describe "ConcFlags" $ matchesTextShowSpec (Proxy :: Proxy ConcFlags)-# if MIN_VERSION_base(4,15,0)+#if MIN_VERSION_base(4,21,0)+ describe "IoManagerFlag" $+ matchesTextShowSpec (Proxy :: Proxy IoManagerFlag)+#elif MIN_VERSION_base(4,15,0) describe "IoSubSystem" $ matchesTextShowSpec (Proxy :: Proxy IoSubSystem)-# endif+#endif describe "MiscFlags" $ matchesTextShowSpec (Proxy :: Proxy MiscFlags) describe "DebugFlags" $@@ -61,10 +63,7 @@ matchesTextShowSpec (Proxy :: Proxy DoHeapProfile') describe "DoTrace" $ matchesTextShowSpec (Proxy :: Proxy DoTrace')-# if MIN_VERSION_base(4,10,0)+#if MIN_VERSION_base(4,10,0) describe "ParFlags" $ matchesTextShowSpec (Proxy :: Proxy ParFlags)-# endif-#else- pure () #endif
tests/Spec/GHC/StackSpec.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE CPP #-}- {-| Module: Spec.GHC.StackSpec Copyright: (C) 2014-2017 Ryan Scott@@ -12,37 +10,25 @@ -} module Spec.GHC.StackSpec (main, spec) where +import Data.Proxy (Proxy(..))++import GHC.Stack (CallStack, SrcLoc)+ import Instances.GHC.Stack () import Prelude () import Prelude.Compat -import Test.Hspec (Spec, hspec, parallel)--#if MIN_VERSION_base(4,8,1)-import Data.Proxy.Compat (Proxy(..))-import GHC.Stack (CallStack)-# if MIN_VERSION_base(4,9,0)-import GHC.Stack (SrcLoc)-# else-import GHC.SrcLoc (SrcLoc)-# endif- import Spec.Utils (matchesTextShowSpec) -import Test.Hspec (describe)-#endif+import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do-#if MIN_VERSION_base(4,8,1) describe "CallStack" $ matchesTextShowSpec (Proxy :: Proxy CallStack) describe "SrcLoc" $ matchesTextShowSpec (Proxy :: Proxy SrcLoc)-#else- pure ()-#endif
tests/Spec/GHC/StaticPtrSpec.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE CPP #-}- {-| Module: Spec.GHC.StaticPtrSpec Copyright: (C) 2014-2017 Ryan Scott@@ -12,28 +10,23 @@ -} module Spec.GHC.StaticPtrSpec (main, spec) where +import Data.Proxy (Proxy(..))++import GHC.StaticPtr (StaticPtrInfo)+ import Instances.GHC.StaticPtr () import Prelude () import Prelude.Compat -import Test.Hspec (Spec, hspec, parallel)--#if MIN_VERSION_base(4,8,0)-import Data.Proxy.Compat (Proxy(..))-import GHC.StaticPtr (StaticPtrInfo) import Spec.Utils (matchesTextShowSpec)-import Test.Hspec (describe)-#endif +import Test.Hspec (Spec, describe, hspec, parallel)+ main :: IO () main = hspec spec spec :: Spec spec = parallel $-#if MIN_VERSION_base(4,8,0) describe "StaticPtrInfo" $ matchesTextShowSpec (Proxy :: Proxy StaticPtrInfo)-#else- pure ()-#endif
tests/Spec/GHC/StatsSpec.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -fno-warn-deprecations #-}+{-# OPTIONS_GHC -Wno-deprecations #-} {-| Module: Spec.GHC.StatsSpec@@ -21,7 +21,7 @@ import Test.Hspec (Spec, hspec, parallel) #if !(MIN_VERSION_base(4,11,0))-import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import GHC.Stats (GCStats) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe)
tests/Spec/GHC/TypeLitsSpec.hs view
@@ -1,8 +1,5 @@-{-# LANGUAGE CPP #-}--#if MIN_VERSION_base(4,6,0) && !(MIN_VERSION_base(4,7,0))+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-}-#endif {-| Module: Spec.GHC.TypeLitsSpec@@ -16,45 +13,40 @@ -} module Spec.GHC.TypeLitsSpec (main, spec) where +import Data.Proxy (Proxy(..))++import GHC.TypeLits+ import Instances.GHC.TypeLits () import Prelude () import Prelude.Compat -import Test.Hspec (Spec, hspec, parallel)--#if MIN_VERSION_base(4,6,0)-import Data.Proxy.Compat (Proxy(..))-import GHC.TypeLits import Spec.Utils (matchesTextShowSpec)-import Test.Hspec (describe)+#if MIN_VERSION_base(4,18,0)+import Spec.Utils (Some) #endif +import Test.Hspec (Spec, describe, hspec, parallel)+ main :: IO () main = hspec spec spec :: Spec spec = parallel $ do-#if MIN_VERSION_base(4,7,0) describe "SomeNat" $ matchesTextShowSpec (Proxy :: Proxy SomeNat) describe "SomeSymbol" $ matchesTextShowSpec (Proxy :: Proxy SomeSymbol)-#elif MIN_VERSION_base(4,6,0)- describe "IsEven 0" $- matchesTextShowSpec (Proxy :: Proxy (IsEven 0))- describe "IsEven 1" $- matchesTextShowSpec (Proxy :: Proxy (IsEven 1))- describe "IsEven 2" $- matchesTextShowSpec (Proxy :: Proxy (IsEven 2))- describe "IsZero 0" $- matchesTextShowSpec (Proxy :: Proxy (IsZero 0))- describe "IsZero 1" $- matchesTextShowSpec (Proxy :: Proxy (IsZero 1))- describe "Sing 0" $- matchesTextShowSpec (Proxy :: Proxy (Sing 0))- describe "Sing \"a\"" $- matchesTextShowSpec (Proxy :: Proxy (Sing "a"))-#else- pure ()+#if MIN_VERSION_base(4,16,0)+ describe "SomeChar" $+ matchesTextShowSpec (Proxy :: Proxy SomeChar)+#endif+#if MIN_VERSION_base(4,18,0)+ describe "Some SNat" $+ matchesTextShowSpec (Proxy :: Proxy (Some SNat))+ describe "Some SSymbol" $+ matchesTextShowSpec (Proxy :: Proxy (Some SSymbol))+ describe "Some SChar" $+ matchesTextShowSpec (Proxy :: Proxy (Some SChar)) #endif
tests/Spec/GenericSpec.hs view
@@ -10,7 +10,7 @@ -} module Spec.GenericSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Instances.Generic () import Instances.Utils (GenericExample) import Spec.Utils (matchesTextShowSpec, matchesTextShow1Spec, genericTextShowSpec)
tests/Spec/Numeric/NaturalSpec.hs view
@@ -10,8 +10,8 @@ -} module Spec.Numeric.NaturalSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))-import Numeric.Natural.Compat (Natural)+import Data.Proxy (Proxy(..))+import Numeric.Natural (Natural) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) import Test.QuickCheck.Instances ()
tests/Spec/OptionsSpec.hs view
@@ -10,7 +10,7 @@ -} module Spec.OptionsSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Instances.Options () import Spec.Utils (matchesTextShowSpec, genericTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel)
tests/Spec/System/ExitSpec.hs view
@@ -10,7 +10,7 @@ -} module Spec.System.ExitSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShowSpec) import System.Exit (ExitCode) import Test.Hspec (Spec, describe, hspec, parallel)
tests/Spec/System/IOSpec.hs view
@@ -10,7 +10,7 @@ -} module Spec.System.IOSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import GHC.IO.Encoding.Failure (CodingFailureMode) import GHC.IO.Encoding.Types (CodingProgress)
tests/Spec/System/Posix/TypesSpec.hs view
@@ -12,7 +12,7 @@ -} module Spec.System.Posix.TypesSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Instances.System.Posix.Types () import Spec.Utils (matchesTextShowSpec) import System.Posix.Types
tests/Spec/Text/ReadSpec.hs view
@@ -1,6 +1,3 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE TemplateHaskell #-}- {-| Module: Spec.Text.ReadSpec Copyright: (C) 2014-2017 Ryan Scott@@ -13,16 +10,12 @@ -} module Spec.Text.ReadSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..))+import Data.Proxy (Proxy(..)) import Instances.Text.Read () import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) import Text.Read (Lexeme)--#if MIN_VERSION_base(4,6,0)-import Language.Haskell.TH.Lib (conT)-import TextShow.TH.Names (numberTypeName)-#endif+import Text.Read.Lex (Number) main :: IO () main = hspec spec@@ -31,7 +24,5 @@ spec = parallel $ do describe "Lexeme" $ matchesTextShowSpec (Proxy :: Proxy Lexeme)-#if MIN_VERSION_base(4,6,0) describe "Number" $- matchesTextShowSpec (Proxy :: Proxy $(conT numberTypeName))-#endif+ matchesTextShowSpec (Proxy :: Proxy Number)
tests/Spec/Utils.hs view
@@ -1,7 +1,14 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-} +#if __GLASGOW_HASKELL__ >= 806+{-# LANGUAGE QuantifiedConstraints #-}+#endif+ {-| Module: Spec.Utils Copyright: (C) 2014-2017 Ryan Scott@@ -16,94 +23,122 @@ matchesTextShowSpec , prop_matchesTextShow , matchesTextShow1Spec-#if defined(NEW_FUNCTOR_CLASSES) , matchesTextShow2Spec-#endif , genericTextShowSpec , genericTextShow1Spec++ , Some(..)+ , GArbitrary(..) ) where -import Data.Functor.Classes (Show1, showsPrec1)-import Data.Proxy.Compat (Proxy(..))+import Data.Functor.Classes (Show1, Show2, showsPrec1, showsPrec2)+import Data.Proxy (Proxy(..)) -import Generics.Deriving.Base+import GHC.Generics+import GHC.Stack (HasCallStack) -import Test.Hspec (Spec)+import Test.Hspec (Expectation, Spec, shouldBe) import Test.Hspec.QuickCheck (prop)-import Test.QuickCheck (Arbitrary)+import Test.QuickCheck (Arbitrary(..), Gen) -import TextShow (TextShow(..), TextShow1(..), showbPrec1, fromString)+import TextShow (TextShow(..), TextShow1(..), TextShow2(..),+ showbPrec1, showbPrec2, fromString) import TextShow.Generic -#if defined(NEW_FUNCTOR_CLASSES)-import Data.Functor.Classes (Show2, showsPrec2)-import TextShow (TextShow2(..), showbPrec2)+#if __GLASGOW_HASKELL__ >= 806+import GHC.Show (appPrec, appPrec1)+import TextShow (showbParen, showbSpace) #endif -- | Expect a type's 'Show' instances to coincide for both 'String's and 'Text', -- irrespective of precedence.-matchesTextShowSpec :: forall a. (Arbitrary a, Show a, TextShow a)+matchesTextShowSpec :: forall a. (HasCallStack, Arbitrary a, Show a, TextShow a) => Proxy a -> Spec-matchesTextShowSpec _ = prop "TextShow instance" (prop_matchesTextShow :: Int -> a -> Bool)+matchesTextShowSpec _ = prop "TextShow instance" (prop_matchesTextShow :: Int -> a -> Expectation) -- | Verifies that a type's 'Show' instances coincide for both 'String's and 'Text', -- irrespective of precedence.-prop_matchesTextShow :: (Show a, TextShow a) => Int -> a -> Bool-prop_matchesTextShow p x = fromString (showsPrec p x "") == showbPrec p x+prop_matchesTextShow :: (HasCallStack, Show a, TextShow a)+ => Int -> a -> Expectation+prop_matchesTextShow p x = showbPrec p x `shouldBe` fromString (showsPrec p x "") -- | Expect a type's 'Show1' instances to coincide for both 'String's and 'Text', -- irrespective of precedence. matchesTextShow1Spec :: forall f a.- (Arbitrary (f a), Show1 f, Show a, Show (f a), TextShow1 f, TextShow a)+ (HasCallStack, Arbitrary (f a), Show1 f, Show a, Show (f a), TextShow1 f, TextShow a) => Proxy (f a) -> Spec-matchesTextShow1Spec _ = prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> f a -> Bool)+matchesTextShow1Spec _ = prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> f a -> Expectation) -- | Verifies that a type's 'Show1' instances coincide for both 'String's and 'Text', -- irrespective of precedence.-prop_matchesTextShow1 :: (Show1 f, Show a, TextShow1 f, TextShow a) => Int -> f a -> Bool-prop_matchesTextShow1 p x = fromString (showsPrec1 p x "") == showbPrec1 p x+prop_matchesTextShow1 :: (HasCallStack, Show1 f, Show a, TextShow1 f, TextShow a)+ => Int -> f a -> Expectation+prop_matchesTextShow1 p x = showbPrec1 p x `shouldBe` fromString (showsPrec1 p x "") -#if defined(NEW_FUNCTOR_CLASSES) -- | Expect a type's 'Show2' instances to coincide for both 'String's and 'Text', -- irrespective of precedence. matchesTextShow2Spec :: forall f a b.- (Arbitrary (f a b), Show2 f, Show a, Show b, Show (f a b),+ (HasCallStack,+ Arbitrary (f a b), Show2 f, Show a, Show b, Show (f a b), TextShow2 f, TextShow a, TextShow b) => Proxy (f a b) -> Spec-matchesTextShow2Spec _ = prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> f a b -> Bool)+matchesTextShow2Spec _ = prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> f a b -> Expectation) -- | Verifies that a type's 'Show2' instances coincide for both 'String's and 'Text', -- irrespective of precedence.-prop_matchesTextShow2 :: (Show2 f, Show a, Show b, TextShow2 f, TextShow a, TextShow b)- => Int -> f a b -> Bool-prop_matchesTextShow2 p x = fromString (showsPrec2 p x "") == showbPrec2 p x-#endif+prop_matchesTextShow2 :: (HasCallStack, Show2 f, Show a, Show b, TextShow2 f, TextShow a, TextShow b)+ => Int -> f a b -> Expectation+prop_matchesTextShow2 p x = showbPrec2 p x `shouldBe` fromString (showsPrec2 p x "") -- | Expect a type's 'TextShow' instance to coincide with the output produced -- by the equivalent 'Generic' functions.-genericTextShowSpec :: forall a. (Arbitrary a, Show a, TextShow a,- Generic a, GTextShowB Zero (Rep a))+genericTextShowSpec :: forall a.+ (HasCallStack,+ Arbitrary a, Show a, TextShow a,+ Generic a, GTextShowB (Rep a ())) => Proxy a -> Spec-genericTextShowSpec _ = prop "generic TextShow" (prop_genericTextShow :: Int -> a -> Bool)+genericTextShowSpec _ = prop "generic TextShow" (prop_genericTextShow :: Int -> a -> Expectation) -- | Verifies that a type's 'TextShow' instance coincides with the output produced -- by the equivalent 'Generic' functions.-prop_genericTextShow :: (TextShow a, Generic a, GTextShowB Zero (Rep a))- => Int -> a -> Bool-prop_genericTextShow p x = showbPrec p x == genericShowbPrec p x+prop_genericTextShow :: (HasCallStack, TextShow a, Generic a, GTextShowB (Rep a ()))+ => Int -> a -> Expectation+prop_genericTextShow p x = showbPrec p x `shouldBe` genericShowbPrec p x -- | Expect a type's 'TextShow1' instance to coincide with the output produced -- by the equivalent 'Generic1' functions.-genericTextShow1Spec :: forall f a. (Arbitrary (f a), Show (f a), TextShow1 f,- Generic1 f, GTextShowB One (Rep1 f), TextShow a)+genericTextShow1Spec :: forall f a.+ (HasCallStack,+ Arbitrary (f a), Show (f a), TextShow1 f,+ Generic1 f, GTextShowB1 (Rep1 f), TextShow a) => Proxy (f a) -> Spec-genericTextShow1Spec _ = prop "generic TextShow1" (prop_genericTextShow1 :: Int -> f a -> Bool)+genericTextShow1Spec _ = prop "generic TextShow1" (prop_genericTextShow1 :: Int -> f a -> Expectation) -- | Verifies that a type's 'TextShow1' instance coincides with the output produced -- by the equivalent 'Generic1' functions.-prop_genericTextShow1 :: ( TextShow1 f, Generic1 f- , GTextShowB One (Rep1 f), TextShow a+prop_genericTextShow1 :: ( HasCallStack+ , TextShow1 f, Generic1 f+ , GTextShowB1 (Rep1 f), TextShow a )- => Int -> f a -> Bool+ => Int -> f a -> Expectation prop_genericTextShow1 p x =- showbPrec1 p x == genericLiftShowbPrec showbPrec showbList p x+ showbPrec1 p x `shouldBe` genericLiftShowbPrec showbPrec showbList p x++-- | A data type that existentially closes over something.+data Some t where+ Some :: t a -> Some t++#if __GLASGOW_HASKELL__ >= 806+deriving instance (forall a. Show (t a)) => Show (Some t)+instance (forall a. TextShow (t a)) => TextShow (Some t) where+ showbPrec p (Some x) =+ showbParen (p > appPrec) $+ fromString "Some" <> showbSpace <> showbPrec appPrec1 x+#endif++instance GArbitrary t => Arbitrary (Some t) where+ arbitrary = garbitrary++-- | An 'Arbitrary'-like class for 1-type-parameter GADTs.+class GArbitrary t where+ garbitrary :: Gen (Some t)
text-show.cabal view
@@ -1,20 +1,11 @@ name: text-show-version: 3.9+version: 3.11.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 @<http://hackage.haskell.org/package/bytestring-show bytestring-show>@. .- At the moment, @text-show@ provides instances for most data- types in the @<http://hackage.haskell.org/package/array array>@,- @<http://hackage.haskell.org/package/base base>@,- @<http://hackage.haskell.org/package/bytestring bytestring>@, and- @<http://hackage.haskell.org/package/text 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: .@@ -33,6 +24,24 @@ . Support for automatically deriving @TextShow@ instances can be found in the "TextShow.TH" and "TextShow.Generic" modules.+ .+ @text-show@ only provides instances for data types in the+ following packages:+ .+ * @<http://hackage.haskell.org/package/array array>@+ .+ * @<http://hackage.haskell.org/package/base base>@+ .+ * @<http://hackage.haskell.org/package/bytestring bytestring>@+ .+ * @<http://hackage.haskell.org/package/text text>@+ .+ This policy is in place to keep @text-show@'s dependencies+ reasonably light. If you need a @TextShow@ instance for a+ library that is not in this list, it may be covered by the+ @<http://hackage.haskell.org/package/text-show-instances text-show-instances>@+ library.+ homepage: https://github.com/RyanGlScott/text-show bug-reports: https://github.com/RyanGlScott/text-show/issues license: BSD3@@ -43,36 +52,32 @@ copyright: (C) 2014-2017 Ryan Scott category: Text build-type: Simple-tested-with: GHC == 7.4.2- , GHC == 7.6.3- , GHC == 7.8.4- , GHC == 7.10.3- , GHC == 8.0.2+tested-with: GHC == 8.0.2 , GHC == 8.2.2 , GHC == 8.4.4 , GHC == 8.6.5- , GHC == 8.8.3- , GHC == 8.10.1-extra-source-files: CHANGELOG.md, README.md, include/*.h+ , GHC == 8.8.4+ , GHC == 8.10.7+ , GHC == 9.0.2+ , GHC == 9.2.8+ , GHC == 9.4.8+ , GHC == 9.6.7+ , GHC == 9.8.4+ , GHC == 9.10.3+ , GHC == 9.12.2+ , GHC == 9.14.1+extra-source-files: CHANGELOG.md, README.md cabal-version: >=1.10 source-repository head type: git location: https://github.com/RyanGlScott/text-show -flag base-4-9- description: Use base-4.9 or later.- default: True--flag template-haskell-2-11- description: Use template-haskell-2.11.0.0 or later.- default: True--flag new-functor-classes- description: Use a version of transformers or transformers-compat with a- modern-style Data.Functor.Classes module. This flag cannot be- used when building with transformers-0.4, since it comes with- a different version of Data.Functor.Classes.+flag integer-gmp+ description: When building with a version of GHC older than 9.0,+ depend on the @integer-gmp@ library. You can disable+ this if you do not wish to link against GMP, but at the+ expense of having a slower @TextShow Natural@ instance. default: True library@@ -82,6 +87,7 @@ TextShow.Control.Exception TextShow.Control.Monad.ST TextShow.Data.Array+ TextShow.Data.Array.Byte TextShow.Data.Bool TextShow.Data.ByteString TextShow.Data.Char@@ -110,6 +116,8 @@ TextShow.Data.Semigroup TextShow.Data.Text TextShow.Data.Tuple+ TextShow.Data.Type.Coercion+ TextShow.Data.Type.Equality TextShow.Data.Typeable TextShow.Data.Version TextShow.Data.Void@@ -118,7 +126,11 @@ TextShow.Functions TextShow.GHC.Fingerprint TextShow.GHC.Generics+ TextShow.GHC.RTS.Flags+ TextShow.GHC.Stack+ TextShow.GHC.StaticPtr TextShow.GHC.Stats+ TextShow.GHC.TypeLits TextShow.Numeric.Natural TextShow.System.Exit TextShow.System.IO@@ -130,22 +142,6 @@ TextShow.GHC.Conc.Windows -- Only exports functions if not using Windows TextShow.GHC.Event-- -- Only exports functions if base >= 4.6- TextShow.GHC.TypeLits-- -- Only exports functions if base >= 4.7- TextShow.Data.Type.Coercion- TextShow.Data.Type.Equality- -- Only exports functions if base >= 4.7 && < 4.8- TextShow.Data.OldTypeable-- -- Only exports functions if base >= 4.8- TextShow.GHC.RTS.Flags- TextShow.GHC.StaticPtr-- -- Only exports functions if base >= 4.8.1- TextShow.GHC.Stack other-modules: TextShow.Classes TextShow.Data.Typeable.Utils TextShow.FromStringTextShow@@ -154,45 +150,30 @@ TextShow.TH.Internal TextShow.TH.Names TextShow.Utils- build-depends: array >= 0.3 && < 0.6- , base-compat-batteries >= 0.11 && < 0.12- , bifunctors >= 5.1 && < 6- , bytestring >= 0.9 && < 0.11- , bytestring-builder- , containers >= 0.1 && < 0.7- , generic-deriving >= 1.11 && < 2+ build-depends: array >= 0.3 && < 0.6+ , base >= 4.9 && < 4.23+ , base-compat-batteries >= 0.11 && < 0.16+ , bifunctors >= 5.1 && < 6+ , bytestring >= 0.10.8.1 && < 0.13+ , containers >= 0.1 && < 0.9+ , ghc-boot-th >= 8.0 && < 9.15 , ghc-prim- , integer-gmp- , text >= 0.11.1 && < 1.3- , th-abstraction >= 0.3 && < 0.5- , th-lift >= 0.7.6 && < 1-- if flag(base-4-9)- build-depends: base >= 4.9 && < 4.16- 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.18- , ghc-boot-th >= 8.0 && < 9.1- else- build-depends: template-haskell >= 2.5 && < 2.11+ , template-haskell >= 2.11 && < 2.25+ , text >= 1.1 && < 2.2+ , th-abstraction >= 0.5 && < 0.8 - 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.*+ -- integer-gmp is only needed on pre-9.0 versions of GHC, as GHC 9.0+ add+ -- enough functionality to base to avoid the use of integer-gmp entirely.+ if !impl(ghc >= 9.0) && flag(integer-gmp)+ build-depends: integer-gmp hs-source-dirs: src, shared default-language: Haskell2010 ghc-options: -Wall if impl(ghc >= 8.6) ghc-options: -Wno-star-is-type- include-dirs: include- includes: generic.h+ if impl(ghc >= 9.0)+ ghc-options: -fenable-th-splice-warnings test-suite spec type: exitcode-stdio-1.0@@ -220,13 +201,19 @@ Instances.Data.Text Instances.Data.Tuple Instances.Data.Typeable+ Instances.Data.Type.Coercion+ Instances.Data.Type.Equality Instances.Foreign.C.Types Instances.Foreign.Ptr Instances.FromStringTextShow Instances.Generic Instances.GHC.Fingerprint Instances.GHC.Generics+ Instances.GHC.RTS.Flags+ Instances.GHC.Stack+ Instances.GHC.StaticPtr Instances.GHC.Stats+ Instances.GHC.TypeLits Instances.Options Instances.System.IO Instances.System.Posix.Types@@ -239,22 +226,6 @@ -- Only exports instances if not using Windows Instances.GHC.Event - -- Only exports instances if base >= 4.6- Instances.GHC.TypeLits-- -- Only exports instances if base >= 4.7- Instances.Data.Type.Coercion- Instances.Data.Type.Equality- -- Only exports instances if base >= 4.7 && < 4.8- Instances.Data.OldTypeable-- -- Only exports instances if base >= 4.8- Instances.GHC.RTS.Flags- Instances.GHC.StaticPtr-- -- Only exports instances if base >= 4.9- Instances.GHC.Stack- -- Only exports instances if base >= 4.12 Instances.Data.Monoid @@ -264,6 +235,7 @@ Spec.Control.ExceptionSpec Spec.Control.Monad.STSpec Spec.Data.ArraySpec+ Spec.Data.Array.ByteSpec Spec.Data.BoolSpec Spec.Data.ByteStringSpec Spec.Data.CharSpec@@ -288,6 +260,8 @@ Spec.Data.SemigroupSpec Spec.Data.TextSpec Spec.Data.TupleSpec+ Spec.Data.Type.CoercionSpec+ Spec.Data.Type.EqualitySpec Spec.Data.TypeableSpec Spec.Data.VersionSpec Spec.Derived.DataFamiliesSpec@@ -307,7 +281,11 @@ Spec.GenericSpec Spec.GHC.FingerprintSpec Spec.GHC.GenericsSpec+ Spec.GHC.RTS.FlagsSpec+ Spec.GHC.StackSpec+ Spec.GHC.StaticPtrSpec Spec.GHC.StatsSpec+ Spec.GHC.TypeLitsSpec Spec.Numeric.NaturalSpec Spec.OptionsSpec Spec.System.ExitSpec@@ -321,70 +299,40 @@ -- Only exports tests if not using Windows Spec.GHC.EventSpec - -- Only exports tests if base >= 4.6- Spec.GHC.TypeLitsSpec-- -- Only exports tests if base >= 4.7- Spec.Data.Type.CoercionSpec- Spec.Data.Type.EqualitySpec- -- Only exports tests if base >= 4.7 && < 4.8- Spec.Data.OldTypeableSpec-- -- Only exports tests if base >= 4.8- Spec.GHC.RTS.FlagsSpec- Spec.GHC.StaticPtrSpec-- -- Only exports tests if base >= 4.9- Spec.GHC.StackSpec- TextShow.TH.Names- build-depends: array >= 0.3 && < 0.6- , base-compat-batteries >= 0.11 && < 0.12- , base-orphans >= 0.8.2 && < 0.9- , bytestring >= 0.9 && < 0.11- , bytestring-builder- , deriving-compat >= 0.5.6 && < 1- , generic-deriving >= 1.11 && < 2+ build-depends: array >= 0.3 && < 0.6+ , base >= 4.9 && < 4.23+ , base-compat-batteries >= 0.11 && < 0.16+ , base-orphans >= 0.8.5 && < 0.10+ , bytestring >= 0.10.8.1 && < 0.13+ , deriving-compat >= 0.6.5 && < 1+ , generic-deriving >= 1.14.1 && < 2 , ghc-prim- , hspec >= 2 && < 3- , QuickCheck >= 2.12 && < 2.15- , quickcheck-instances >= 0.3.18 && < 0.4- , template-haskell >= 2.5 && < 2.18- , text >= 0.11.1 && < 1.3+ , hspec >= 2 && < 3+ , QuickCheck >= 2.14.3 && < 2.19+ , quickcheck-instances >= 0.3.28 && < 0.5+ , template-haskell >= 2.11 && < 2.25+ , text >= 1.1 && < 2.2 , text-show- , transformers-compat >= 0.5 && < 1+ , transformers-compat >= 0.5 && < 1 build-tool-depends: hspec-discover:hspec-discover - if flag(base-4-9)- build-depends: base >= 4.9 && < 4.16- cpp-options: "-DNEW_FUNCTOR_CLASSES"- else- build-depends: base >= 4.5 && < 4.9-- 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.*- hs-source-dirs: tests, shared default-language: Haskell2010 ghc-options: -Wall -threaded -rtsopts if impl(ghc >= 8.6) ghc-options: -Wno-star-is-type- include-dirs: include- includes: generic.h- , overlap.h+ if impl(ghc >= 9.0)+ ghc-options: -fenable-th-splice-warnings benchmark bench type: exitcode-stdio-1.0 main-is: Bench.hs- build-depends: base >= 4.5 && < 4.16+ build-depends: base >= 4.9 && < 4.23 , criterion >= 1.1.4 && < 2 , deepseq >= 1.3 && < 2- , ghc-prim , text-show- , text >= 0.11.1 && < 1.3+ , text >= 1.1 && < 2.2 hs-source-dirs: benchmarks default-language: Haskell2010