text-show 3.6.2 → 3.11.4
raw patch · 155 files changed
Files
- CHANGELOG.md +221/−0
- README.md +17/−5
- benchmarks/Bench.hs +56/−52
- include/generic.h +0/−11
- include/overlap.h +0/−16
- shared/TextShow/TH/Names.hs +22/−50
- src/TextShow/Classes.hs +30/−25
- src/TextShow/Control/Applicative.hs +2/−5
- src/TextShow/Control/Concurrent.hs +18/−6
- src/TextShow/Control/Exception.hs +31/−26
- src/TextShow/Control/Monad/ST.hs +1/−1
- src/TextShow/Data/Array.hs +10/−7
- 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 +12/−13
- src/TextShow/Data/Complex.hs +25/−1
- src/TextShow/Data/Data.hs +7/−7
- src/TextShow/Data/Dynamic.hs +2/−2
- src/TextShow/Data/Either.hs +1/−1
- src/TextShow/Data/Fixed.hs +12/−25
- src/TextShow/Data/Floating.hs +51/−47
- src/TextShow/Data/Functor/Compose.hs +1/−1
- src/TextShow/Data/Functor/Identity.hs +1/−1
- src/TextShow/Data/Functor/Product.hs +4/−4
- src/TextShow/Data/Functor/Sum.hs +4/−4
- src/TextShow/Data/Integral.hs +3/−17
- src/TextShow/Data/List.hs +1/−1
- src/TextShow/Data/List/NonEmpty.hs +1/−1
- src/TextShow/Data/Maybe.hs +1/−1
- src/TextShow/Data/Monoid.hs +21/−17
- src/TextShow/Data/OldTypeable.hs +0/−58
- src/TextShow/Data/Ord.hs +24/−8
- src/TextShow/Data/Proxy.hs +2/−5
- src/TextShow/Data/Ratio.hs +4/−3
- src/TextShow/Data/Semigroup.hs +2/−7
- src/TextShow/Data/Text.hs +22/−35
- src/TextShow/Data/Tuple.hs +26/−3
- src/TextShow/Data/Type/Coercion.hs +1/−8
- src/TextShow/Data/Type/Equality.hs +2/−14
- src/TextShow/Data/Typeable.hs +128/−69
- src/TextShow/Data/Typeable/Utils.hs +1/−2
- src/TextShow/Data/Version.hs +1/−2
- src/TextShow/Data/Void.hs +1/−1
- 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 +9/−5
- src/TextShow/FromStringTextShow.hs +93/−288
- src/TextShow/Functions.hs +1/−1
- src/TextShow/GHC/Conc/Windows.hs +3/−3
- src/TextShow/GHC/Event.hs +5/−14
- src/TextShow/GHC/Fingerprint.hs +4/−2
- src/TextShow/GHC/Generics.hs +9/−23
- src/TextShow/GHC/RTS/Flags.hs +32/−19
- src/TextShow/GHC/Stack.hs +6/−22
- src/TextShow/GHC/StaticPtr.hs +1/−8
- src/TextShow/GHC/Stats.hs +11/−2
- src/TextShow/GHC/TypeLits.hs +49/−54
- src/TextShow/Generic.hs +417/−265
- src/TextShow/Instances.hs +1/−1
- src/TextShow/Numeric/Natural.hs +11/−6
- src/TextShow/Options.hs +18/−35
- src/TextShow/System/Exit.hs +1/−1
- src/TextShow/System/IO.hs +4/−2
- src/TextShow/System/Posix/Types.hs +1/−1
- src/TextShow/TH.hs +2/−2
- src/TextShow/TH/Internal.hs +360/−151
- src/TextShow/Text/Read.hs +5/−12
- src/TextShow/Utils.hs +2/−21
- 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 +116/−31
- tests/Derived/PolyKinds.hs +10/−136
- tests/Derived/RankNTypes.hs +16/−35
- tests/Derived/Records.hs +2/−45
- tests/Derived/TypeFamilies.hs +52/−0
- tests/Derived/TypeSynonyms.hs +5/−55
- tests/Instances/Control/Concurrent.hs +1/−1
- tests/Instances/Control/Exception.hs +11/−7
- tests/Instances/Control/Monad/ST.hs +1/−1
- tests/Instances/Data/ByteString.hs +0/−23
- 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 +24/−0
- tests/Instances/Data/OldTypeable.hs +0/−43
- tests/Instances/Data/Ord.hs +4/−1
- tests/Instances/Data/Semigroup.hs +4/−1
- tests/Instances/Data/Text.hs +6/−22
- tests/Instances/Data/Tuple.hs +2/−11
- tests/Instances/Data/Type/Coercion.hs +1/−7
- tests/Instances/Data/Type/Equality.hs +3/−15
- tests/Instances/Data/Typeable.hs +20/−30
- 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 +5/−1
- tests/Instances/GHC/Generics.hs +2/−8
- tests/Instances/GHC/RTS/Flags.hs +58/−32
- tests/Instances/GHC/Stack.hs +12/−25
- tests/Instances/GHC/StaticPtr.hs +1/−7
- tests/Instances/GHC/Stats.hs +8/−2
- tests/Instances/GHC/TypeLits.hs +27/−20
- tests/Instances/Generic.hs +44/−3
- tests/Instances/Options.hs +4/−4
- tests/Instances/System/IO.hs +10/−12
- tests/Instances/System/Posix/Types.hs +1/−1
- tests/Instances/Text/Read.hs +6/−26
- tests/Instances/Utils.hs +9/−2
- tests/Instances/Utils/GenericArbitrary.hs +1/−2
- tests/Spec/BuilderSpec.hs +11/−11
- tests/Spec/Control/ApplicativeSpec.hs +0/−2
- tests/Spec/Control/ExceptionSpec.hs +7/−6
- tests/Spec/Data/Array/ByteSpec.hs +40/−0
- tests/Spec/Data/ArraySpec.hs +2/−2
- tests/Spec/Data/ByteStringSpec.hs +0/−2
- tests/Spec/Data/EitherSpec.hs +0/−1
- tests/Spec/Data/FixedSpec.hs +3/−3
- tests/Spec/Data/FloatingSpec.hs +16/−7
- tests/Spec/Data/IntegralSpec.hs +7/−8
- tests/Spec/Data/ListSpec.hs +3/−3
- tests/Spec/Data/MonoidSpec.hs +8/−2
- tests/Spec/Data/OldTypeableSpec.hs +0/−47
- tests/Spec/Data/OrdSpec.hs +0/−2
- tests/Spec/Data/ProxySpec.hs +0/−2
- tests/Spec/Data/SemigroupSpec.hs +1/−3
- tests/Spec/Data/TextSpec.hs +0/−13
- tests/Spec/Data/TupleSpec.hs +13/−1
- tests/Spec/Data/Type/CoercionSpec.hs +5/−13
- tests/Spec/Data/Type/EqualitySpec.hs +3/−15
- tests/Spec/Data/TypeableSpec.hs +6/−7
- tests/Spec/Data/VersionSpec.hs +3/−3
- tests/Spec/Derived/DataFamiliesSpec.hs +3/−19
- tests/Spec/Derived/MagicHashSpec.hs +18/−1
- tests/Spec/Derived/RecordsSpec.hs +6/−0
- tests/Spec/Derived/TypeFamiliesSpec.hs +32/−0
- tests/Spec/FromStringTextShowSpec.hs +4/−21
- tests/Spec/GHC/Conc/WindowsSpec.hs +2/−2
- tests/Spec/GHC/EventSpec.hs +3/−8
- tests/Spec/GHC/GenericsSpec.hs +7/−30
- tests/Spec/GHC/RTS/FlagsSpec.hs +16/−13
- tests/Spec/GHC/StackSpec.hs +5/−19
- tests/Spec/GHC/StaticPtrSpec.hs +6/−13
- tests/Spec/GHC/StatsSpec.hs +13/−7
- tests/Spec/GHC/TypeLitsSpec.hs +20/−28
- tests/Spec/GenericSpec.hs +13/−6
- tests/Spec/Text/ReadSpec.hs +2/−11
- tests/Spec/Utils.hs +76/−41
- text-show.cabal +109/−214
CHANGELOG.md view
@@ -1,3 +1,224 @@+### 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+ deprecated as of `base-4.15.0.0`.+* Fix a bug in which `deriveTextShow{1,2}` would needlessly reject data types+ whose last type parameters appear as oversaturated arguments to a type+ family.++### 3.8.5 [2020.02.28]+* Import from `GHC.Exts`, not `GHC.Prim`.++### 3.8.4 [2020.01.28]+* Update the `TextShow(1)` instances for `Down` and `ThreadId` to match their+ implementations in `base-4.14`.++### 3.8.3 [2019.11.06]+* Use `base-compat-batteries-0.11.0` to define instances for `(:~:)` back to+ `base-4.5` and instances for `(:~~:)` back to `base-4.9`.++### 3.8.2 [2019.05.02]+* Make the `TextShow` instances for `UArray` and `Fixed` use the correct+ precedence on `base-4.13` or later.+* Support deriving `TextShow(1)(2)` instances for data types with fields+ of type `Int8#`, `Int16#`, `Word8#`, or `Word16#` on GHC 8.8 or later.++### 3.8.1 [2019.04.26]+* Support `th-abstraction-0.3` or later.++## 3.8 [2019.03.19]+* Remove the `TextShow I16` instance from `TextShow.Data.Text`. The usefulness+ of this instance was dubious at best, and moreover, it was actively causing+ issues when building `text-show` with `reflex-platform` (see+ [#40](https://github.com/RyanGlScott/text-show/issues/40)).++### 3.7.5 [2018.10.07]+* _Actually_ make `showbEFloat`'s behavior match that of `showEFloat` in+ `base-4.12`.+* Remove uses of `AutoDeriveTypeable`, since it is now deprecated. (As a+ result, some things which used to have `Typeable` instances on GHC 7.8+ no longer do, but I'm choosing not to be bothered by this unless someone+ shouts.)++### 3.7.4 [2018.07.03]+* Add `FromGeneric` and `FromGeneric1` newtype adapters to `TextShow.Generic`.+ These are suitable for use with `DerivingVia`, and provide a convenient way+ to obtain `Generic(1)`-based defaults for `TextShow(1)` instances.+* Add `TextShow(1)` instances for `Data.Monoid.Ap` on `base-4.12` or later.+* Make `showbEFloat`'s behavior match that of `showEFloat` in `base-4.12`.++### 3.7.3 [2018.04.07]+* Use `base-compat-batteries`.+* Add a `TextShow FixIOException` instance on `base-4.11` or later.++### 3.7.2 [2018.03.08]+* Depend on `quickcheck-instances-0.3.18` or later.++### 3.7.1 [2017.12.29]+* Don't define a `TextShow GCStats` instance on GHC 8.4 or later, as `GCStats`+ has been removed from `base`. This fixes the build on GHC 8.4.++## 3.7 [2017.12.07]+* Use `EmptyCase` on GHC 7.8 or later for `TextShow(1)` instances for empty data types that are derived using `TextShow.Generic`.+* Derived `TextShow(1)(2)` instances (using `TextShow.TH`) will now force their argument instead of simply `error`ing.+* Add `emptyCaseBehavior` to `Options`, which configures whether derived instances (using `TextShow.TH`) for empty data types should use the `EmptyCase` extension (this is disabled by default).+ ### 3.6.2 [2017.06.18] * Drop support for GHC 7.0 and 7.2 * Require `QuickCheck-2.10`/`quickcheck-instances-0.13.6` or later
README.md view
@@ -1,9 +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://github.com/RyanGlScott/text-show/actions?query=workflow%3AHaskell-CI) [Hackage: text-show]: http://hackage.haskell.org/package/text-show@@ -17,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@@ -30,6 +27,21 @@ main = printT (Just "Hello, World!") ``` -If you desire it, there are also monomorphic versions of the `showb` function available in the submodules of `Text.Show.Text`. See the [naming conventions](https://github.com/RyanGlScott/text-show/wiki/Naming-conventions) page for more information.+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)@@ -27,6 +27,59 @@ import TextShow.Generic (genericShowbPrec, genericShowtPrec, genericShowtlPrec) import TextShow.TH (deriveTextShow) +-------------------------------------------------------------------------------+-- Tree-like ADTs+-------------------------------------------------------------------------------++-- NB: constructors must be same length!+data BinTree1 a = BTEmpty1+ | BTLeaf1 a+ | BTBranch1 (BinTree1 a) (BinTree1 a)+ deriving Show++data BinTree2 a = BTEmpty2+ | BTLeaf2 a+ | BTBranch2 (BinTree2 a) (BinTree2 a)++data BinTree3 a = BTEmpty3+ | BTLeaf3 a+ | BTBranch3 (BinTree3 a) (BinTree3 a)+ deriving Generic++instance TextShow a => TextShow (BinTree3 a) where+ showbPrec = genericShowbPrec++-------------------------------------------------------------------------------+-- Simple enumeration types+-------------------------------------------------------------------------------++data Color = Red | Green | Blue | Orange | Violet+ deriving (Generic, Show)++newtype Color2 = Color2 Color++instance TextShow Color2 where+ showbPrec p (Color2 c) = genericShowbPrec p c+ showtPrec p (Color2 c) = genericShowtPrec p c+ showtlPrec p (Color2 c) = genericShowtlPrec p c++colorShowt :: Color -> T.Text+colorShowt c = case c of+ Red -> T.pack "Red"+ Green -> T.pack "Green"+ Blue -> T.pack "Blue"+ Orange -> T.pack "Orange"+ Violet -> T.pack "Violet"++-------------------------------------------------------------------------------++$(deriveTextShow ''BinTree2)+$(deriveTextShow ''Color)++-------------------------------------------------------------------------------+-- Benchmarks+-------------------------------------------------------------------------------+ main :: IO () main = defaultMain [ sampleGroup "String Show" BTLeaf1 BTBranch1 BTEmpty1 show@@ -42,10 +95,6 @@ ] ] ----------------------------------------------------------------------------------- Tree-like ADTs--------------------------------------------------------------------------------- sampleGroup :: forall a b. NFData b => String -> (Int -> a) -> (a -> a -> a) -> a -> (a -> b) -> Benchmark sampleGroup title leaf branch empty showFun =@@ -72,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@@ -85,48 +134,3 @@ (leaf 12345 `branch` leaf 1234) `branch` leaf 123456 `branch` (leaf 1234567 `branch` leaf 123456)---- NB: constructors must be same length!-data BinTree1 a = BTEmpty1- | BTLeaf1 a- | BTBranch1 (BinTree1 a) (BinTree1 a)- deriving Show--data BinTree2 a = BTEmpty2- | BTLeaf2 a- | BTBranch2 (BinTree2 a) (BinTree2 a)--data BinTree3 a = BTEmpty3- | BTLeaf3 a- | BTBranch3 (BinTree3 a) (BinTree3 a)- deriving Generic--instance TextShow a => TextShow (BinTree3 a) where- showbPrec = genericShowbPrec------------------------------------------------------------------------------------ Simple enumeration types----------------------------------------------------------------------------------data Color = Red | Green | Blue | Orange | Violet- deriving (Generic, Show)--newtype Color2 = Color2 Color--instance TextShow Color2 where- showbPrec p (Color2 c) = genericShowbPrec p c- showtPrec p (Color2 c) = genericShowtPrec p c- showtlPrec p (Color2 c) = genericShowtlPrec p c--colorShowt :: Color -> T.Text-colorShowt c = case c of- Red -> T.pack "Red"- Green -> T.pack "Green"- Blue -> T.pack "Blue"- Orange -> T.pack "Orange"- Violet -> T.pack "Violet"-----------------------------------------------------------------------------------$(deriveTextShow ''BinTree2)-$(deriveTextShow ''Color)
− 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,26 @@ 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,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"+#endif -- | The 'Name' of 'evtClose'. evtCloseValName :: Name@@ -54,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,10 +17,6 @@ -} module TextShow.Classes where -#if __GLASGOW_HASKELL__ >= 708-import Data.Data (Typeable)-#endif-import Data.Monoid.Compat ((<>)) import qualified Data.Text as TS (Text, singleton) import qualified Data.Text.IO as TS (putStrLn, hPutStrLn) import qualified Data.Text.Lazy as TL (Text, singleton)@@ -31,6 +27,9 @@ import GHC.Show (appPrec, appPrec1) +import Prelude ()+import Prelude.Compat+ import System.IO (Handle) import TextShow.Utils (toString, toText)@@ -46,7 +45,7 @@ -- to combine 'Builder's when creating 'TextShow' instances. As an example: -- -- @--- import Data.Monoid+-- import Data.Semigroup -- import TextShow -- -- data Example = Example Int Int@@ -57,7 +56,7 @@ -- If you do not want to create 'TextShow' instances manually, you can alternatively -- use the "TextShow.TH" module to automatically generate default 'TextShow' -- instances using Template Haskell, or the "TextShow.Generic" module to--- quickly define 'TextShow' instances using 'genericShowbPrec'.+-- quickly define 'TextShow' instances using "GHC.Generics". -- -- /Since: 2/ class TextShow a where@@ -173,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/@@ -397,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. --@@ -415,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. --@@ -464,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. --@@ -485,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
@@ -1,8 +1,9 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# 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@@ -17,22 +18,33 @@ -} module TextShow.Control.Concurrent () where -import Data.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (fromString) import Foreign.C.Types import GHC.Conc (BlockReason, ThreadStatus) import GHC.Conc.Sync (ThreadId(..))-import GHC.Prim+import GHC.Exts (Addr#, unsafeCoerce#) +import Prelude ()+import Prelude.Compat+ import TextShow.Classes (TextShow(..)) import TextShow.Foreign.C.Types () import TextShow.TH.Internal (deriveTextShow) +#if MIN_VERSION_base(4,14,0)+import TextShow.Classes (showbParen)+import GHC.Show (appPrec)+#endif+ -- | /Since: 2/ instance TextShow ThreadId where- showbPrec p t = fromString "ThreadId " <> showbPrec p (getThreadId t)+ showbPrec p t =+#if MIN_VERSION_base(4,14,0)+ showbParen (p > appPrec) $+#endif+ fromString "ThreadId " <> showbPrec p (getThreadId t) {-# INLINE showbPrec #-} -- Temporary workaround until Trac #8281 is fixed@@ -42,6 +54,6 @@ getThreadId (ThreadId tid) = getThreadId# (unsafeCoerce# tid) -- | /Since: 2/-$(deriveTextShow ''ThreadStatus)--- | /Since: 2/ $(deriveTextShow ''BlockReason)+-- | /Since: 2/+$(deriveTextShow ''ThreadStatus)
src/TextShow/Control/Exception.hs view
@@ -1,7 +1,11 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+#if __GLASGOW_HASKELL__ >= 806+{-# LANGUAGE DerivingVia #-}+#endif+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Control.Exception Copyright: (C) 2014-2017 Ryan Scott@@ -18,9 +22,8 @@ import Control.Exception.Base -import Data.Monoid.Compat ((<>)) 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 @@ -32,14 +35,22 @@ import TextShow.TH.Internal (deriveTextShow) -- | /Since: 2/+#if __GLASGOW_HASKELL__ >= 806+deriving via FromStringShow SomeException instance TextShow SomeException+#else instance TextShow SomeException where showbPrec p (SomeException e) = showbPrec p $ FromStringShow e {-# INLINE showbPrec #-}+#endif -- | /Since: 2/+#if __GLASGOW_HASKELL__ >= 806+deriving via FromStringShow IOException instance TextShow IOException+#else instance TextShow IOException where showb = showb . FromStringShow {-# INLINE showb #-}+#endif -- | /Since: 2/ instance TextShow ArithException where@@ -48,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@@ -69,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@@ -106,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.@@ -132,6 +129,14 @@ showb (CompactionFailed why) = fromString ("compaction failed: " <> why) #endif +#if MIN_VERSION_base(4,11,0)+-- | Only available with @base-4.11.0.0@ or later.+--+-- /Since: 3.7.3/+instance TextShow FixIOException where+ showbPrec _ FixIOException = fromString "cyclic evaluation in fixIO"+#endif+ -- | /Since: 2/ instance TextShow Deadlock where showb Deadlock = "<<deadlock>>"@@ -164,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,6 +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@@ -22,7 +23,6 @@ import Data.Array.Base (IArray) import Data.Array.Unboxed (UArray) import Data.Ix (Ix)-import Data.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (Builder) import GHC.Show (appPrec)@@ -34,19 +34,22 @@ import TextShow.Data.List () import TextShow.Data.Tuple () -{-# SPECIALIZE- showbIArrayPrec :: (IArray UArray e, Ix i, TextShow i, TextShow e) =>- Int -> UArray i e -> Builder- #-} -- | Convert an 'IArray' instance to a 'Builder' with the given precedence. -- -- /Since: 2/ showbIArrayPrec :: (IArray a e, Ix i, TextShow i, TextShow e) => Int -> a i e -> Builder-showbIArrayPrec p a = showbParen (p > 9) $+showbIArrayPrec p a = showbParen (p > arrayPrec) $ "array " <> showb (IArray.bounds a) <> showbSpace <> showb (IArray.assocs a)+ where+ arrayPrec :: Int+#if MIN_VERSION_base(4,13,0)+ arrayPrec = appPrec+#else+ arrayPrec = 9+#endif -- | /Since: 2/ instance (TextShow i, TextShow e, Ix i) => TextShow (Array i e) where
+ 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@@ -24,7 +24,6 @@ import Data.Array (Array, (!), listArray) import Data.Char (GeneralCategory, isDigit, ord)-import Data.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (Builder, singleton) import Prelude ()@@ -34,6 +33,17 @@ import TextShow.Data.Integral () import TextShow.TH.Internal (deriveTextShow) +-- | /Since: 2/+$(deriveTextShow ''GeneralCategory)++-- | /Since: 2/+instance TextShow Char where+ showb = showbChar+ {-# INLINE showb #-}++ showbList = showbString+ {-# INLINE showbList #-}+ -- | A table of ASCII control characters that needs to be escaped with a backslash. -- -- /Since: 2/@@ -95,14 +105,3 @@ showbGeneralCategory :: GeneralCategory -> Builder showbGeneralCategory = showb {-# INLINE showbGeneralCategory #-}---- | /Since: 2/-instance TextShow Char where- showb = showbChar- {-# INLINE showb #-}-- showbList = showbString- {-# INLINE showbList #-}---- | /Since: 2/-$(deriveTextShow ''GeneralCategory)
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@@ -23,15 +23,15 @@ import TextShow.TH.Internal (deriveTextShow) -- | /Since: 2/-$(deriveTextShow ''DataType)+instance TextShow Constr where+ showb = fromString . showConstr+ {-# INLINE showb #-}+ -- | /Since: 2/ $(deriveTextShow ''DataRep) -- | /Since: 2/+$(deriveTextShow ''DataType)+-- | /Since: 2/ $(deriveTextShow ''ConstrRep) -- | /Since: 2/ $(deriveTextShow ''Fixity)---- | /Since: 2/-instance TextShow Constr where- showb = fromString . showConstr- {-# INLINE showb #-}
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@@ -15,9 +15,9 @@ module TextShow.Data.Dynamic () where import Data.Dynamic (Dynamic, dynTypeRep)-import Data.Monoid.Compat ((<>)) import Prelude ()+import Prelude.Compat import TextShow.Classes (TextShow(..)) import TextShow.Data.Typeable ()
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,20 @@ -} 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.Monoid.Compat ((<>))-import Data.Semigroup (mtimesDefault)-import Data.Text.Lazy.Builder (singleton)- import TextShow.Data.Integral () import TextShow.Utils (lengthB)-#else-import Data.Fixed (Fixed, showFixed)-import Data.Text.Lazy.Builder (fromString)++#if MIN_VERSION_base(4,13,0)+import TextShow.Classes (showbParen) #endif -- | Convert a 'Fixed' value to a 'Builder', where the first argument indicates@@ -41,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)@@ -51,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@@ -84,9 +68,12 @@ withDotB b | b == mempty = mempty | otherwise = singleton '.' <> b {-# INLINE withDotB #-}-#endif -- | /Since: 2/ instance HasResolution a => TextShow (Fixed a) where+#if MIN_VERSION_base(4,13,0)+ showbPrec p n = showbParen (p > 6 && n < 0) $ showbFixed False n+#else showb = showbFixed False {-# INLINE showb #-}+#endif
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@@ -29,16 +29,39 @@ import Data.Array.Base (unsafeAt) import Data.Array.IArray (Array, array)-import Data.Monoid.Compat ((<>)) import qualified Data.Text as T (replicate) import Data.Text.Lazy.Builder (Builder, fromString, fromText, singleton) import Data.Text.Lazy.Builder.Int (decimal) import Data.Text.Lazy.Builder.RealFloat (FPFormat(..)) +import Prelude ()+import Prelude.Compat+ import TextShow.Classes (TextShow(..), showbParen) import TextShow.TH.Internal (deriveTextShow) import TextShow.Utils (i2d) +-------------------------------------------------------------------------------+-- TextShow instances+-------------------------------------------------------------------------------++-- | /Since: 2/+$(deriveTextShow ''FPFormat)++-- | /Since: 2/+instance TextShow Float where+ showbPrec = showbRealFloatPrec+ {-# INLINE showbPrec #-}++-- | /Since: 2/+instance TextShow Double where+ showbPrec = showbRealFloatPrec+ {-# INLINE showbPrec #-}++-------------------------------------------------------------------------------+-- Standalone showb* functions+-------------------------------------------------------------------------------+ -- | Convert a 'RealFloat' value to a 'Builder' with the given precedence. -- -- /Since: 2/@@ -48,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@).@@ -171,6 +191,20 @@ [d] -> singleton d <> ".0e" <> show_e' (d:ds') -> singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> show_e' [] -> error "formatRealFloat/doFmt/Exponent: []"+ Just d | d <= 0 ->+ -- handle this case specifically since we need to omit the+ -- decimal point as well (#15115).+ -- Note that this handles negative precisions as well for consistency+ -- (see #15509).+ case is of+ [0] -> "0e0"+ _ ->+ let+ (ei,is') = roundTo 1 is+ n = case map i2d (if ei > 0 then init is' else is') of+ n':_ -> n'+ [] -> error "formatRealFloatAltB (Exponent, negative decs): Unexpected empty list"+ in singleton n <> singleton 'e' <> decimal (e-1+ei) Just dec -> let dec' = max dec 1 in case is of@@ -178,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 ->@@ -206,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') @@ -320,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@@ -339,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. @@ -384,20 +405,3 @@ -- | Cached powers of 10. expts10 :: Array Int Integer expts10 = array (minExpt,maxExpt10) [(n,10^n) | n <- [minExpt .. maxExpt10]]------------------------------------------------------------------------------------ TextShow instances------------------------------------------------------------------------------------ | /Since: 2/-instance TextShow Float where- showbPrec = showbRealFloatPrec- {-# INLINE showbPrec #-}---- | /Since: 2/-instance TextShow Double where- showbPrec = showbRealFloatPrec- {-# INLINE showbPrec #-}---- | /Since: 2/-$(deriveTextShow ''FPFormat)
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@@ -22,9 +22,9 @@ import TextShow.TH.Internal (deriveTextShow1) -- | /Since: 3/+$(deriveTextShow1 ''Product)++-- | /Since: 3/ instance (TextShow1 f, TextShow1 g, TextShow a) => TextShow (Product f g a) where showbPrec = showbPrec1 {-# INLINE showbPrec #-}---- | /Since: 3/-$(deriveTextShow1 ''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@@ -22,9 +22,9 @@ import TextShow.TH.Internal (deriveTextShow1) -- | /Since: 3/+$(deriveTextShow1 ''Sum)++-- | /Since: 3/ instance (TextShow1 f, TextShow1 g, TextShow a) => TextShow (Sum f g a) where showbPrec = showbPrec1 {-# INLINE showbPrec #-}---- | /Since: 3/-$(deriveTextShow1 ''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@@ -24,17 +24,11 @@ import Data.Char (intToDigit) import Data.Int (Int8, Int16, Int32, Int64)-import Data.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (Builder, singleton) import Data.Text.Lazy.Builder.Int (decimal) import Data.Word (Word8, Word16, Word32, Word64) -import GHC.Exts (Int(I#))-#if __GLASGOW_HASKELL__ >= 708-import GHC.Exts (isTrue#)-import GHC.Prim (Int#)-#endif-import GHC.Prim ((<#), (>#))+import GHC.Exts (Int(I#), (<#), (>#), isTrue#) import Prelude () import Prelude.Compat@@ -105,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
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,16 +16,15 @@ -} 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)+import TextShow.TH.Internal (deriveTextShow, deriveTextShow1, makeShowbPrec) -#if MIN_VERSION_base(4,8,0)-import Data.Monoid (Alt)-import TextShow.Classes (TextShow(..))-import TextShow.TH.Internal (makeShowbPrec)+#if MIN_VERSION_base(4,12,0)+import Data.Monoid (Ap) #endif -- | /Since: 2/@@ -55,15 +52,22 @@ -- | /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)++#if MIN_VERSION_base(4,12,0)+-- | Only available with @base-4.12.0.0@ or later.+--+-- /Since: 3.7.4/+instance TextShow (f a) => TextShow (Ap f a) where+ showbPrec = $(makeShowbPrec ''Ap)++-- | Only available with @base-4.12.0.0@ or later.+--+-- /Since: 3.7.4/+$(deriveTextShow1 ''Ap) #endif
− src/TextShow/Data/OldTypeable.hs
@@ -1,58 +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.Monoid.Compat ((<>))-import Data.OldTypeable.Internal (TyCon(TyCon, tyConName), TypeRep(..),- funTc, listTc)-import Data.Text.Lazy.Builder (fromString, singleton)--import TextShow.Classes (TextShow(..), showbParen, showbSpace)-import TextShow.Data.Typeable.Utils (showbArgs, showbTuple)-import TextShow.Utils (isTupleString)---- | Does the 'TyCon' represent a tuple type constructor?-isTupleTyCon :: TyCon -> Bool-isTupleTyCon (TyCon _ _ _ str) = isTupleString str-{-# INLINE isTupleTyCon #-}---- | /Since: 2/-instance TextShow TyCon where- showb = fromString . tyConName- {-# INLINE showb #-}---- | /Since: 2/-instance TextShow TypeRep where- showbPrec p (TypeRep _ tycon tys) =- case tys of- [] -> showb tycon- [x] | tycon == listTc -> singleton '[' <> showb x <> singleton ']'- [a,r] | tycon == funTc -> showbParen (p > 8) $- showbPrec 9 a- <> " -> "- <> showbPrec 8 r- xs | isTupleTyCon tycon -> showbTuple xs- | otherwise -> showbParen (p > 9) $- showbPrec p tycon- <> showbSpace- <> showbArgs showbSpace tys- {-# INLINE showbPrec #-}-#endif
src/TextShow/Data/Ord.hs view
@@ -1,5 +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@@ -14,12 +15,27 @@ -} module TextShow.Data.Ord () where -import GHC.Exts (Down)-import TextShow.TH.Internal (deriveTextShow, deriveTextShow1)+import GHC.Exts (Down(..)) --- | /Since: 2/-$(deriveTextShow ''Ordering)--- | /Since: 2/-$(deriveTextShow ''Down)+import TextShow.Classes ( TextShow(..), TextShow1(..)+ , showbPrec1, showbUnaryWith )+import TextShow.TH.Internal (deriveTextShow)++-- | This instance would be equivalent to a derived 'TextShow' instance+-- if the 'getDown' field were removed.+--+-- /Since: 2/+instance TextShow a => TextShow (Down a) where+ showbPrec = showbPrec1+ {-# INLINE showbPrec #-}++-- | This instance would be equivalent to a derived 'TextShow1' instance+-- if the 'getDown' field were removed.+--+-- /Since: 2/+instance TextShow1 Down where+ liftShowbPrec sp _ p (Down x) = showbUnaryWith sp "Down" p x+ {-# INLINE liftShowbPrec #-}+ -- | /Since: 2/-$(deriveTextShow1 ''Down)+$(deriveTextShow ''Ordering)
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
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@@ -15,9 +15,10 @@ -} module TextShow.Data.Ratio () where -import Data.Monoid.Compat ((<>))- import GHC.Real (Ratio(..), ratioPrec, ratioPrec1)++import Prelude ()+import Prelude.Compat import TextShow.Classes (TextShow(..), TextShow1(..), showbParen) import TextShow.Data.Integral ()
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 (Min, Max, First, Last, WrappedMonoid, Option, Arg)+import Data.Semigroup (Min, Max, First, Last, WrappedMonoid, Arg) import TextShow.Data.Maybe () import TextShow.TH.Internal (deriveTextShow, deriveTextShow1, deriveTextShow2)@@ -44,11 +44,6 @@ $(deriveTextShow ''WrappedMonoid) -- | /Since: 3/ $(deriveTextShow1 ''WrappedMonoid)---- | /Since: 3/-$(deriveTextShow ''Option)--- | /Since: 3/-$(deriveTextShow1 ''Option) -- | /Since: 3/ $(deriveTextShow ''Arg)
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@@ -13,36 +10,37 @@ Stability: Provisional Portability: GHC -'TextShow' instances for 'Text' types.+Defines 'TextShow' instances for 'Text' types, as well as other miscellaneous+data types from the @text@ package. +Note that this module deliberately does not define a 'TextShow' instance for+the @I16@ data type from @Data.Text.Foreign@, as that module is not available+on certain widely used variants of GHC (e.g., @reflex-platform@). See #40+for more details. If this is a problem for you, please file an issue.+ /Since: 2/ -} module TextShow.Data.Text () where -import Data.Monoid.Compat ((<>)) import qualified Data.Text as TS+import Data.Text.Encoding (Decoding(..)) import Data.Text.Encoding.Error (UnicodeException(..))-import Data.Text.Foreign (I16)+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 TextShow.Classes (TextShow(..))+import GHC.Show (appPrec)++import Prelude ()+import Prelude.Compat++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@@ -59,9 +57,6 @@ {-# INLINE showb #-} -- | /Since: 2/-$(deriveTextShow ''I16)---- | /Since: 2/ instance TextShow UnicodeException where showb (DecodeError desc (Just w)) = "Cannot decode byte '\\x" <> showbHex w <> "': " <> fromString desc@@ -72,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,12 +1,8 @@-{-# LANGUAGE CPP #-}--#if MIN_VERSION_base(4,7,0) {-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-#endif+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Type.Equality Copyright: (C) 2014-2017 Ryan Scott@@ -16,17 +12,12 @@ Portability: GHC 'TextShow' instance for propositional equality.-Only provided if using @base-4.7.0.0@ or later. /Since: 2/ -} module TextShow.Data.Type.Equality () where -#if MIN_VERSION_base(4,7,0)-import Data.Type.Equality ((:~:))-# if MIN_VERSION_base(4,10,0)-import Data.Type.Equality ((:~~:))-# endif+import Data.Type.Equality.Compat import TextShow.Classes (TextShow1(..)) import TextShow.TH.Internal (deriveTextShow, deriveTextShow2, makeLiftShowbPrec)@@ -41,7 +32,6 @@ -- | /Since: 2/ $(deriveTextShow2 ''(:~:)) -# if MIN_VERSION_base(4,10,0) -- | /Since: 3.6/ $(deriveTextShow ''(:~~:)) @@ -51,5 +41,3 @@ -- | /Since: 3.6/ $(deriveTextShow2 ''(:~~:))-# endif-#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@@ -29,56 +26,54 @@ -} module TextShow.Data.Typeable () where +import Prelude ()+import Prelude.Compat+ #if MIN_VERSION_base(4,10,0)-import Data.Monoid.Compat ((<>)) import Data.Kind (Type) import Data.Text.Lazy.Builder (Builder, fromString, singleton) import Data.Type.Equality ((:~~:)(..)) -import GHC.Exts (Char(..))-import GHC.Prim (Addr#, (+#), eqChar#, indexCharOffAddr#)+import GHC.Exts (Addr#, Char(..), (+#), eqChar#, indexCharOffAddr#) import GHC.Types (Module(..), TrName(..), TyCon(..), isTrue#) import TextShow.Classes (TextShow(..), TextShow1(..), showbParen, showbSpace)-import TextShow.Data.Typeable.Utils (showbArgs, showbTuple)-import 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.Monoid.Compat ((<>))-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 (Char(..))-import GHC.Prim (Addr#, (+#), 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 @@ -96,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.@@ -135,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)@@ -160,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 @(->))@@ -172,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 <> " -> "@@ -197,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@@ -244,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,11 +6,10 @@ 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 -import Data.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (Builder, singleton) import Prelude ()
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@@ -15,7 +15,6 @@ module TextShow.Data.Version (showbVersion) where import Data.List (intersperse)-import Data.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (Builder, fromString, singleton) import Data.Version (Version(..))
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
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,17 +16,16 @@ -} module TextShow.Foreign.Ptr () where -import Data.Monoid.Compat ((<>)) import Data.Semigroup (mtimesDefault) import Data.Text.Lazy.Builder (Builder, singleton) import Foreign.ForeignPtr (ForeignPtr) import Foreign.Ptr (FunPtr, IntPtr, WordPtr, castFunPtrToPtr) +import GHC.Exts (addr2Int#, int2Word#) import GHC.ForeignPtr (unsafeForeignPtrToPtr)-import GHC.Num (wordToInteger)+import GHC.Num import GHC.Ptr (Ptr(..))-import GHC.Prim (addr2Int#, int2Word#) import Prelude () import Prelude.Compat@@ -46,13 +45,18 @@ -- | /Since: 2/ instance TextShow1 Ptr where- liftShowbPrec _ _ _ (Ptr a) = padOut . showbHex $ wordToInteger (int2Word# (addr2Int# a))+ liftShowbPrec _ _ _ (Ptr a) = padOut . showbHex $+ integerFromWord# (int2Word# (addr2Int# a)) where padOut :: Builder -> Builder padOut ls = singleton '0' <> singleton 'x' <> mtimesDefault (max 0 $ 2*SIZEOF_HSPTR - lengthB ls) (singleton '0') <> ls++#if !(MIN_VERSION_base(4,15,0))+ integerFromWord# = wordToInteger+#endif -- | /Since: 2/ instance TextShow (FunPtr a) where
src/TextShow/FromStringTextShow.hs view
@@ -1,31 +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__ >= 708-{-# LANGUAGE AutoDeriveTypeable #-}-#endif--#if __GLASGOW_HASKELL__ >= 800-{-# LANGUAGE DeriveLift #-}-#endif--{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -Wno-name-shadowing #-} {-| Module: TextShow.FromStringTextShow@@ -46,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@@ -73,17 +54,11 @@ showbPrec1, showbPrec2, showbPrecToShowsPrec, showsPrecToShowbPrec, showbToShows, showsToShowb)-import TextShow.Utils (coerce) -#if defined(NEW_FUNCTOR_CLASSES)-import Data.Functor.Classes (Show2(..), showsPrec1, showsPrec2)-#else-import Text.Show (showListWith)-#endif- ------------------------------------------------------------------------------- --- | The 'TextShow' instance for 'FromStringShow' is based on its @String@+-- | An adapter newtype, suitable for @DerivingVia@.+-- The 'TextShow' instance for 'FromStringShow' is based on its @String@ -- 'Show' instance. That is, -- -- @@@ -96,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@@ -124,29 +94,10 @@ show = coerce (show :: a -> String) showList = coerce (showList :: [a] -> ShowS) -instance Show1 FromStringShow where-#if defined(NEW_FUNCTOR_CLASSES)- liftShowList _ sl = sl . coerceList- where- coerceList :: [FromStringShow a] -> [a]- coerceList = coerce- liftShowsPrec sp _ p = sp p . fromStringShow-#else- showsPrec1 p = showsPrec p . fromStringShow-#endif--instance TextShow1 FromStringShow where- liftShowbPrec sp' _ p =- showsPrecToShowbPrec (showbPrecToShowsPrec sp') p . fromStringShow-- liftShowbList _ sl' = showsToShowb (showbToShows sl') . coerceList- where- coerceList :: [FromStringShow a] -> [a]- coerceList = coerce- ------------------------------------------------------------------------------- --- | The @String@ 'Show' instance for 'FromTextShow' is based on its+-- | An adapter newtype, suitable for @DerivingVia@.+-- The @String@ 'Show' instance for 'FromTextShow' is based on its -- 'TextShow' instance. That is, -- -- @@@ -159,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@@ -183,30 +129,10 @@ show (FromTextShow x) = showbToShows showb x "" showList l = showbToShows showbList (coerce l :: [a]) -instance Show1 FromTextShow where-#if defined(NEW_FUNCTOR_CLASSES)- liftShowList _ sl = showbToShows (showsToShowb sl) . coerceList- where- coerceList :: [FromTextShow a] -> [a]- coerceList = coerce- liftShowsPrec sp _ p- = showbPrecToShowsPrec (showsPrecToShowbPrec sp) p . fromTextShow-#else- showsPrec1 p- = showbPrecToShowsPrec (showsPrecToShowbPrec showsPrec) p . fromTextShow-#endif--instance TextShow1 FromTextShow where- liftShowbPrec sp' _ p = sp' p . fromTextShow-- liftShowbList _ sl' = sl' . coerceList- where- coerceList :: [FromTextShow a] -> [a]- coerceList = coerce- ------------------------------------------------------------------------------- --- | The 'TextShow1' instance for 'FromStringShow1' is based on its @String@+-- | An adapter newtype, suitable for @DerivingVia@.+-- The 'TextShow1' instance for 'FromStringShow1' is based on its @String@ -- 'Show1' instance. That is, -- -- @@@ -219,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)@@ -278,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@@ -286,7 +190,8 @@ ------------------------------------------------------------------------------- --- | The @String@ 'Show1' instance for 'FromTextShow1' is based on its+-- | An adapter newtype, suitable for @DerivingVia@.+-- The @String@ 'Show1' instance for 'FromTextShow1' is based on its -- 'TextShow1' instance. That is, -- -- @@@ -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 @@ -367,7 +253,8 @@ ------------------------------------------------------------------------------- --- | The 'TextShow2' instance for 'FromStringShow2' is based on its @String@+-- | An adapter newtype, suitable for @DerivingVia@.+-- The 'TextShow2' instance for 'FromStringShow2' is based on its @String@ -- 'Show2' instance. That is, -- -- @@@ -382,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)@@ -453,20 +322,18 @@ coerceList :: [FromStringShow2 f a b] -> [f a b] coerceList = coerce --- | Not available if using @transformers-0.4@ instance (Show2 f, Show a, Show b) => Show (FromStringShow2 f a b) where showsPrec = showsPrec2 showList = liftShowList2 showsPrec showList showsPrec showList --- | Not available if using @transformers-0.4@ instance (Show2 f, Show a) => Show1 (FromStringShow2 f a) where liftShowsPrec = liftShowsPrec2 showsPrec showList liftShowList = liftShowList2 showsPrec showList-#endif ------------------------------------------------------------------------------- --- | The @String@ 'Show2' instance for 'FromTextShow2' is based on its+-- | An adapter newtype, suitable for @DerivingVia@.+-- The @String@ 'Show2' instance for 'FromTextShow2' is based on its -- 'TextShow2' instance. That is, -- -- @@@ -481,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)@@ -549,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@@ -561,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,13 +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.Monoid.Compat ((<>)) 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) @@ -40,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@@ -63,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,12 +14,14 @@ -} module TextShow.GHC.Fingerprint () where -import Data.Monoid.Compat ((<>)) import Data.Semigroup (mtimesDefault) import Data.Text.Lazy.Builder (Builder, singleton) import Data.Word (Word64) import GHC.Fingerprint.Type (Fingerprint(..))++import Prelude ()+import Prelude.Compat import TextShow.Classes (TextShow(..)) import TextShow.Data.Integral (showbHex)
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 ()@@ -33,10 +32,10 @@ makeLiftShowbPrec, makeLiftShowbPrec2) -- | /Since: 2/+$(deriveTextShow1 ''U1)+-- | /Since: 2/ instance TextShow (U1 p) where showbPrec = liftShowbPrec undefined undefined--- | /Since: 2/-$(deriveTextShow1 ''U1) -- | /Since: 2/ $(deriveTextShow ''Par1)@@ -115,25 +114,12 @@ $(deriveTextShow1 'UWord) -- | /Since: 2/-$(deriveTextShow ''Fixity)--- | /Since: 2/ $(deriveTextShow ''Associativity)-#if MIN_VERSION_base(4,9,0)--- | Only available with @base-4.9.0.0@ or later.------ /Since: 3/+-- | /Since: 2/+$(deriveTextShow ''Fixity)+-- | /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 ()@@ -32,12 +32,27 @@ import TextShow.TH.Names (giveGCStatsTypeName, doCostCentresTypeName, doHeapProfileTypeName, doTraceTypeName) --- | /Since: 2/-$(deriveTextShow ''RTSFlags)+-- | /Since: 2.1/+$(deriveTextShow giveGCStatsTypeName)+-- | /Since: 2.1/+$(deriveTextShow doCostCentresTypeName)+-- | /Since: 2.1/+$(deriveTextShow doHeapProfileTypeName)+-- | /Since: 2.1/+$(deriveTextShow doTraceTypeName)+ -- | /Since: 2/ $(deriveTextShow ''GCFlags) -- | /Since: 2/ $(deriveTextShow ''ConcFlags)+#if MIN_VERSION_base(4,15,0)+-- | /Since: 3.9/+$(deriveTextShow ''SubSystem.IoSubSystem)+#endif+#if MIN_VERSION_base(4,21,0)+-- | /Since: 3.11/+$(deriveTextShow ''IoManagerFlag)+#endif -- | /Since: 2/ $(deriveTextShow ''MiscFlags) -- | /Since: 2/@@ -50,19 +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---- | /Since: 2.1/-$(deriveTextShow giveGCStatsTypeName)--- | /Since: 2.1/-$(deriveTextShow doCostCentresTypeName)--- | /Since: 2.1/-$(deriveTextShow doHeapProfileTypeName)--- | /Since: 2.1/-$(deriveTextShow doTraceTypeName) #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)
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,37 +10,24 @@ 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 () import TextShow.Data.Tuple () import TextShow.TH.Internal (deriveTextShow) -# if MIN_VERSION_base(4,9,0) -- | /Since: 3.0.1/+$(deriveTextShow ''SrcLoc)++-- | /Since: 3.0.1/ instance TextShow CallStack where showb = showb . getCallStack {-# INLINE showb #-}-# else--- | /Since: 3.0.1/-$(deriveTextShow ''CallStack)-# endif---- | /Since: 3.0.1/-$(deriveTextShow ''SrcLoc)-#endif
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
@@ -1,7 +1,14 @@ {-# LANGUAGE CPP #-}++#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 {-| Module: TextShow.GHC.Stats@@ -17,6 +24,7 @@ -} module TextShow.GHC.Stats () where +#if !(MIN_VERSION_base(4,11,0)) import GHC.Stats (GCStats) import TextShow.Data.Integral ()@@ -25,3 +33,4 @@ -- /Since: 2/ $(deriveTextShow ''GCStats)+#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,64 +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.Monoid.Compat ((<>))-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,7 +1,13 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveLift #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE EmptyCase #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}@@ -9,20 +15,17 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-}--#if __GLASGOW_HASKELL__ >= 706-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE PolyKinds #-}-#endif+{-# LANGUAGE UndecidableInstances #-} -#if __GLASGOW_HASKELL__ >= 800-{-# LANGUAGE DeriveLift #-}+#if __GLASGOW_HASKELL__ >= 806+{-# LANGUAGE QuantifiedConstraints #-} #endif {-|@@ -43,12 +46,13 @@ /Since: 2/ -} module TextShow.Generic (+ -- * Generic adapter newtypes+ FromGeneric(..)+ , FromGeneric1(..)+ -- * Generic @show@ functions -- $generics-- -- ** Understanding a compiler error- -- $generic_err- genericShowt+ , genericShowt , genericShowtl , genericShowtPrec , genericShowtlPrec@@ -67,25 +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 (Contravariant(..))-import Data.Monoid.Compat ((<>)) import qualified Data.Text as TS (Text, pack, singleton) import qualified Data.Text.IO as TS (putStrLn, hPutStrLn) import qualified Data.Text.Lazy as TL (Text, pack, singleton)@@ -93,12 +96,12 @@ import qualified Data.Text.Lazy.Builder as TB (fromString, singleton) import Data.Text.Lazy.Builder (Builder) -import Generics.Deriving.Base+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@@ -117,147 +120,205 @@ {- $generics 'TextShow' instances can be easily defined for data types that are 'Generic' instances.-The easiest way to do this is to use the @DeriveGeneric@ extension.+If you are using GHC 8.6 or later, the easiest way to do this is to use the+@DerivingVia@ extension. @-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveGeneric, DerivingVia #-} import GHC.Generics import TextShow import TextShow.Generic data D a = D a- deriving (Generic, Generic1)--instance TextShow a => TextShow (D a) where- showbPrec = 'genericShowbPrec'--instance TextShow1 D where- liftShowbPrec = 'genericLiftShowbPrec'+ deriving ('Generic', 'Generic1')+ deriving 'TextShow' via 'FromGeneric' (D a)+ deriving 'TextShow1' via 'FromGeneric1' D @--} -{- $generic_err--Suppose you intend to use 'genericShowbPrec' to define a 'TextShow' instance.+Or, if you are using a version of GHC older than 8.6, one can alternatively+define these instances like so: @-data Oops = Oops- -- forgot to add \"deriving Generic\" here!+instance 'TextShow' a => 'TextShow' (D a) where+ 'showbPrec' = 'genericShowbPrec' -instance TextShow Oops where- showbPrec = 'genericShowbPrec'+instance 'TextShow1' D where+ 'liftShowbPrec' = 'genericLiftShowbPrec' @+-} -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:+-- | An adapter newtype, suitable for @DerivingVia@.+-- The 'TextShow' instance for 'FromGeneric' leverages a 'Generic'-based+-- default. That is,+--+-- @+-- 'showbPrec' p ('FromGeneric' x) = 'genericShowbPrec' p x+-- @+--+-- /Since: 3.7.4/+newtype FromGeneric a = FromGeneric { fromGeneric :: a }+ deriving ( Data+ , Eq+ , Foldable+ , Functor+ , Generic+ , Generic1+ , Ord+ , Read+ , Show+ , Traversable+ , Lift+ ) -@-No instance for ('GTextShowB' 'Zero' (Rep Oops))-@+-- | /Since: 3.7.4/+instance (Generic a, GTextShowB (Rep a ())) => TextShow (FromGeneric a) where+ showbPrec p = genericShowbPrec p . fromGeneric -This error can be confusing, but don't let it intimidate you. The correct fix is-simply to add the missing \"@deriving 'Generic'@\" clause.+-- | An adapter newtype, suitable for @DerivingVia@.+-- The 'TextShow1' instance for 'FromGeneric1' leverages a 'Generic1'-based+-- default. That is,+--+-- @+-- 'liftShowbPrec' sp sl p ('FromGeneric1' x) = 'genericLiftShowbPrec' sp sl p x+-- @+--+-- /Since: 3.7.4/+newtype FromGeneric1 f a = FromGeneric1 { fromGeneric1 :: f a }+ deriving ( Eq+ , Ord+ , Read+ , Show+ , Generic+ , Generic1+ , Lift+ ) -Similarly, if the compiler complains about not having an instance for @('GTextShowB'-'One' (Rep1 Oops1))@, add a \"@deriving 'Generic1'@\" clause.--}+deriving instance Foldable f => Foldable (FromGeneric1 f)+deriving instance Functor f => Functor (FromGeneric1 f)+deriving instance Traversable f => Traversable (FromGeneric1 f)+deriving instance ( Data (f a), Typeable f, Typeable a+ ) => Data (FromGeneric1 f (a :: *)) +-- | /Since: 3.10/+instance (Generic1 f, GTextShowB (Rep1 f a)) => TextShow (FromGeneric1 f a) where+ showbPrec p = gShowbPrec p . from1 . fromGeneric1++-- | /Since: 3.7.4/+instance ( Generic1 f+#if __GLASGOW_HASKELL__ >= 806 && __GLASGOW_HASKELL__ < 902+ -- Unfortunately, the quantified superclass for GTextShowB1 doesn't+ -- work on pre-9.2 versions of GHC when using a GTextShowB1 (Rep1 f)+ -- constraint directly, perhaps due to+ -- https://gitlab.haskell.org/ghc/ghc/-/issues/14860#note_454218.+ -- Fortunately, we can make GHC come to its senses by using an+ -- equality constraint.+ , g ~ Rep1 f, GTextShowB1 g+#else+ , GTextShowB1 (Rep1 f)+#endif+ ) => TextShow1 (FromGeneric1 f) where+ liftShowbPrec sp sl p = genericLiftShowbPrec sp sl p . fromGeneric1+ -- | A 'Generic' implementation of 'showt'. -- -- /Since: 2/-genericShowt :: (Generic a, GTextShowT 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'),@@ -271,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@@ -299,231 +347,339 @@ dictinary lookups is likely to be as bad as converting to Text at the end, if not worse. Therefore, I perform some ugly CPP hackery to copy-paste the generic functionality three-times, once for each Text/Builder variant. I suppose I could use TH instead to make this-look a little nicer, but I haven't attempted that.+times, once for each Text/Builder variant. At some point, I should replace this with TH.+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 -#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'). \+#if __GLASGOW_HASKELL__ >= 806+#define QUANTIFIED_SUPERCLASS(class_name,f) (forall a. TextShow a => class_name (f a)) =>+#else+#define QUANTIFIED_SUPERCLASS(class_name,f)+#endif++#define GTEXT_SHOW(text_type,show_funs,one_hash,two_hash,gtext_show,gtext_show1,gshow_prec,glift_show_prec,gtext_show_con,gtext_show_con1,gshow_prec_con,glift_show_prec_con,show_prec,lift_show_prec,show_space,show_paren,show_list,show_list_with,from_char,from_string,c1_show_prec,s1_show_prec,product_show_prec,u_char_show_prec,u_double_show_prec,u_float_show_prec,u_int_show_prec,u_word_show_prec) \+{- | Class of generic representation types that can be converted to a \+'text_type'. \ \-/Since: 3.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 Zero V1 where { \- gshow_prec _ _ !_ = error "Void show_prec" \- }; \+instance TextShow c => gtext_show_con (K1 i c p) where { \+ ; gshow_prec_con _ p (K1 x) = show_prec p x \+}; \ \-instance gtext_show One V1 where { \- gshow_prec _ _ !_ = error "Void lift_show_prec" \- }; \+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 (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 (Selector s, gtext_show_con (f p)) => gtext_show_con (S1 s f p) where { \+ ; gshow_prec_con t = s1_show_prec $ gshow_prec_con t \+}; \ \-instance (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 (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 \+}; \ \- ; 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 (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 \+}; \ \- ; 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 gtext_show_con (UChar p) where { \+ ; gshow_prec_con _ = u_char_show_prec show_prec \+}; \ \- ; conIsTuple :: C1 c f p -> Bool \- ; conIsTuple = isTupleString . conName \- }; \- }; \+instance gtext_show_con (UDouble p) where { \+ ; gshow_prec_con _ = u_double_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 (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.@@ -570,7 +726,3 @@ ------------------------------------------------------------------------------- $(deriveTextShow ''ConType)--#if __GLASGOW_HASKELL__ < 800-$(deriveLift ''ConType)-#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@@ -17,10 +15,14 @@ -} module TextShow.Numeric.Natural () where -#if MIN_VERSION_base(4,8,0)+#if MIN_VERSION_base(4,15,0)+import GHC.Exts (Word(..))+import GHC.Num (integerFromNatural)+import GHC.Num.Natural (Natural(..))+#elif defined(MIN_VERSION_integer_gmp)+import GHC.Exts (Word(..)) import GHC.Integer.GMP.Internals (Integer(..)) import GHC.Natural (Natural(..))-import GHC.Types (Word(..)) #else import Numeric.Natural (Natural) #endif@@ -30,7 +32,10 @@ -- | /Since: 2/ instance TextShow Natural where-#if MIN_VERSION_base(4,8,0)+#if MIN_VERSION_base(4,15,0)+ showbPrec p (NS w) = showbPrec p (W# w)+ showbPrec p n = showbPrec p (integerFromNatural n)+#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,24 +1,9 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}--#if __GLASGOW_HASKELL__ >= 706-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE PolyKinds #-}-#endif--#if __GLASGOW_HASKELL__ >= 708-{-# LANGUAGE AutoDeriveTypeable #-}-#endif--#if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE DeriveLift #-}-#endif {-|-Module: TextShow.FromStringTextShow+Module: TextShow.Options Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott@@ -31,30 +16,35 @@ -} module TextShow.Options (Options(..), GenTextMethods(..), defaultOptions) where -import Data.Data (Data, Typeable)-import Data.Ix (Ix)+import Data.Data (Data)+import Data.Ix (Ix) -import GHC.Generics (Generic)+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. -- -- /Since: 3.4/-newtype Options = Options+data Options = Options { genTextMethods :: GenTextMethods -- ^ When Template Haskell should generate definitions for methods which -- return @Text@?+ --+ -- /Since: 3.4/+ , emptyCaseBehavior :: Bool+ -- ^ If 'True', derived instances for empty data types (i.e., ones with+ -- no data constructors) will use the @EmptyCase@ language extension.+ -- If 'False', derived instances will simply use 'seq' instead.+ --+ -- /Since: 3.7/ } deriving ( Data , Eq , Generic , Ord , Read , Show- , Typeable-#if __GLASGOW_HASKELL__ >= 800 , Lift-#endif ) -- | When should Template Haskell generate implementations for the methods of@@ -74,21 +64,14 @@ , Ord , Read , Show- , Typeable-#if __GLASGOW_HASKELL__ >= 800 , Lift-#endif ) -- | Sensible default 'Options'. -- -- /Since: 3.4/ defaultOptions :: Options-defaultOptions = Options { genTextMethods = SometimesTextMethods }-----------------------------------------------------------------------------------#if __GLASGOW_HASKELL__ < 800-$(deriveLift ''Options)-$(deriveLift ''GenTextMethods)-#endif+defaultOptions =+ Options { genTextMethods = SometimesTextMethods+ , emptyCaseBehavior = False+ }
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@@ -15,13 +15,15 @@ -} module TextShow.System.IO () where -import Data.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (Builder, fromString, singleton) import GHC.IO.Encoding.Failure (CodingFailureMode) import GHC.IO.Encoding.Types (CodingProgress, TextEncoding(textEncodingName)) import GHC.IO.Handle (HandlePosn(..)) import GHC.IO.Handle.Types (Handle(..))++import Prelude ()+import Prelude.Compat import System.IO (BufferMode, IOMode, Newline, NewlineMode, SeekMode)
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@@ -22,5 +22,5 @@ ------------------------------------------------------------------------------- -$(deriveTextShow ''Options) $(deriveTextShow ''GenTextMethods)+$(deriveTextShow ''Options)
src/TextShow/TH/Internal.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE TemplateHaskell #-} {-| Module: TextShow.TH.Internal Copyright: (C) 2014-2017 Ryan Scott@@ -56,14 +57,13 @@ ) where import Control.Monad (unless, when)-import Data.Foldable.Compat-import Data.List.Compat-import qualified Data.List.NonEmpty as NE (reverse)+import qualified Control.Monad as Monad (fail)+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-import Data.Monoid.Compat ((<>)) import qualified Data.Set as Set import Data.Set (Set) import qualified Data.Text as TS@@ -74,11 +74,33 @@ import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.IO as TL (putStrLn, hPutStrLn) -import GHC.Exts (Char(..), Double(..), Float(..), Int(..), Word(..))-import GHC.Prim (Char#, Double#, Float#, Int#, Word#)+import GHC.Exts ( Char(..), Double(..), Float(..), Int(..), Word(..)+ , Char#, Double#, Float#, Int#, Word#+#if MIN_VERSION_base(4,13,0)+ , Int8#, Int16#, Word8#, Word16#+# if MIN_VERSION_base(4,16,0)+ , Int32#, Word32#+# if MIN_VERSION_base(4,19,0)+ , Int64#, Word64#+# else+ , int8ToInt#, int16ToInt#, int32ToInt#+ , intToInt8#, intToInt16#, intToInt32#+ , word8ToWord#, word16ToWord#, word32ToWord#+ , wordToWord8#, wordToWord16#, wordToWord32#+# endif+# else+ , extendInt8#, extendInt16#, extendWord8#, extendWord16#+ , narrowInt8#, narrowInt16#, narrowWord8#, narrowWord16#+# endif+#endif+ ) import GHC.Show (appPrec, appPrec1)+#if MIN_VERSION_base(4,19,0)+import GHC.Int (Int8(..), Int16(..), Int32(..), Int64(..))+import GHC.Word (Word8(..), Word16(..), Word32(..), Word64(..))+#endif -import Language.Haskell.TH.Datatype+import Language.Haskell.TH.Datatype as Datatype import Language.Haskell.TH.Lib import Language.Haskell.TH.Ppr hiding (appPrec) import Language.Haskell.TH.Syntax@@ -349,14 +371,14 @@ -- -- /Since: 2/ makeShowtPrec :: Name -> Q Exp-makeShowtPrec = makeShowbPrecClass TextShow ShowtPrec+makeShowtPrec = makeShowbPrecClass TextShow ShowtPrec defaultOptions -- | Generates a lambda expression which behaves like 'showtlPrec' (without -- requiring a 'TextShow' instance). -- -- /Since: 2/ makeShowtlPrec :: Name -> Q Exp-makeShowtlPrec = makeShowbPrecClass TextShow ShowtlPrec+makeShowtlPrec = makeShowbPrecClass TextShow ShowtlPrec defaultOptions -- | Generates a lambda expression which behaves like 'showtList' (without requiring a -- 'TextShow' instance).@@ -384,14 +406,14 @@ -- -- /Since: 2/ makeShowbPrec :: Name -> Q Exp-makeShowbPrec = makeShowbPrecClass TextShow ShowbPrec+makeShowbPrec = makeShowbPrecClass TextShow ShowbPrec defaultOptions -- | Generates a lambda expression which behaves like 'liftShowbPrec' (without -- requiring a 'TextShow1' instance). -- -- /Since: 3/ makeLiftShowbPrec :: Name -> Q Exp-makeLiftShowbPrec = makeShowbPrecClass TextShow1 ShowbPrec+makeLiftShowbPrec = makeShowbPrecClass TextShow1 ShowbPrec defaultOptions -- | Generates a lambda expression which behaves like 'showbPrec1' (without -- requiring a 'TextShow1' instance).@@ -405,7 +427,7 @@ -- -- /Since: 3/ makeLiftShowbPrec2 :: Name -> Q Exp-makeLiftShowbPrec2 = makeShowbPrecClass TextShow2 ShowbPrec+makeLiftShowbPrec2 = makeShowbPrecClass TextShow2 ShowbPrec defaultOptions -- | Generates a lambda expression which behaves like 'showbPrec2' (without -- requiring a 'TextShow2' instance).@@ -459,23 +481,23 @@ deriveTextShowClass tsClass opts name = do info <- reifyDatatype name case info of- DatatypeInfo { datatypeContext = ctxt- , datatypeName = parentName- , datatypeVars = vars- , datatypeVariant = variant- , datatypeCons = cons+ DatatypeInfo { datatypeContext = ctxt+ , datatypeName = parentName+ , datatypeInstTypes = instTys+ , datatypeVariant = variant+ , datatypeCons = cons } -> do (instanceCxt, instanceType)- <- buildTypeInstance tsClass parentName ctxt vars variant+ <- buildTypeInstance tsClass parentName ctxt instTys variant (:[]) <$> instanceD (return instanceCxt) (return instanceType)- (showbPrecDecs tsClass opts vars cons)+ (showbPrecDecs tsClass opts instTys cons) -- | Generates a declaration defining the primary function corresponding to a -- particular class (showbPrec for TextShow, liftShowbPrec for TextShow1, and -- liftShowbPrec2 for TextShow2). showbPrecDecs :: TextShowClass -> Options -> [Type] -> [ConstructorInfo] -> [Q Dec]-showbPrecDecs tsClass opts vars cons =+showbPrecDecs tsClass opts instTys cons = [genMethod ShowbPrec (showbPrecName tsClass)] ++ if tsClass == TextShow && shouldGenTextMethods then [genMethod ShowtPrec 'showtPrec, genMethod ShowtlPrec 'showtlPrec]@@ -491,52 +513,64 @@ genMethod method methodName = funD methodName [ clause []- (normalB $ makeTextShowForCons tsClass method vars cons)+ (normalB $ makeTextShowForCons tsClass method opts instTys cons) [] ] -- | Generates a lambda expression which behaves like showbPrec (for TextShow), -- liftShowbPrec (for TextShow1), or liftShowbPrec2 (for TextShow2).-makeShowbPrecClass :: TextShowClass -> TextShowFun -> Name -> Q Exp-makeShowbPrecClass tsClass tsFun name = do+makeShowbPrecClass :: TextShowClass -> TextShowFun -> Options -> Name -> Q Exp+makeShowbPrecClass tsClass tsFun opts name = do info <- reifyDatatype name case info of- DatatypeInfo { datatypeContext = ctxt- , datatypeName = parentName- , datatypeVars = vars- , datatypeVariant = variant- , datatypeCons = cons+ DatatypeInfo { datatypeContext = ctxt+ , datatypeName = parentName+ , datatypeInstTypes = instTys+ , datatypeVariant = variant+ , datatypeCons = cons } -> -- We force buildTypeInstance here since it performs some checks for whether -- or not the provided datatype can actually have showbPrec/liftShowbPrec/etc. -- implemented for it, and produces errors if it can't.- buildTypeInstance tsClass parentName ctxt vars variant- `seq` makeTextShowForCons tsClass tsFun vars cons+ buildTypeInstance tsClass parentName ctxt instTys variant+ >> makeTextShowForCons tsClass tsFun opts instTys cons -- | Generates a lambda expression for showbPrec/liftShowbPrec/etc. for the -- given constructors. All constructors must be from the same type.-makeTextShowForCons :: TextShowClass -> TextShowFun -> [Type] -> [ConstructorInfo]+makeTextShowForCons :: TextShowClass -> TextShowFun -> Options -> [Type] -> [ConstructorInfo] -> Q Exp-makeTextShowForCons _ _ _ [] = error "Must have at least one data constructor"-makeTextShowForCons tsClass tsFun vars cons = do+makeTextShowForCons tsClass tsFun opts instTys cons = do p <- newName "p" value <- newName "value" sps <- newNameList "sp" $ fromEnum tsClass sls <- newNameList "sl" $ fromEnum tsClass let spls = zip sps sls spsAndSls = interleave sps sls- lastTyVars = map varTToName $ drop (length vars - fromEnum tsClass) vars+ lastTyVars = map varTToName $ drop (length instTys - fromEnum tsClass) instTys splMap = Map.fromList $ zip lastTyVars spls- matches <- mapM (makeTextShowForCon p tsClass tsFun splMap) cons++ makeFun+ | null cons && emptyCaseBehavior opts+ = caseE (varE value) []++ | null cons+ = appE (varE 'seq) (varE value) `appE`+ appE (varE 'error)+ (stringE $ "Void " ++ nameBase (showPrecName tsClass tsFun))++ | otherwise+ = caseE (varE value)+ (map (makeTextShowForCon p tsClass tsFun splMap) cons)+ lamE (map varP $ spsAndSls ++ [p, value]) . appsE $ [ varE $ showPrecConstName tsClass tsFun- , caseE (varE value) (map return matches)+ , makeFun ] ++ map varE spsAndSls ++ [varE p, varE value] --- | Generates a lambda expression for howbPrec/liftShowbPrec/etc. for a+-- | Generates a lambda expression for showbPrec/liftShowbPrec/etc. for a -- single constructor. makeTextShowForCon :: Name -> TextShowClass@@ -579,7 +613,7 @@ then do let showArgs = zipWith (makeTextShowForArg 0 tsClass tsFun conName tvMap) argTys' args parenCommaArgs = (varE (singletonName tsFun) `appE` charE '(')- : intersperse (varE (singletonName tsFun) `appE` charE ',') showArgs+ : List.intersperse (varE (singletonName tsFun) `appE` charE ',') showArgs mappendArgs = foldr' (`infixApp` [| (<>) |]) (varE (singletonName tsFun) `appE` charE ')') parenCommaArgs@@ -660,7 +694,7 @@ ) [] --- | Generates a lambda expression for howbPrec/liftShowbPrec/etc. for an+-- | Generates a lambda expression for showbPrec/liftShowbPrec/etc. for an -- argument of a constructor. makeTextShowForArg :: Int -> TextShowClass@@ -678,33 +712,25 @@ showPrecE = varE (showPrecName TextShow tsFun) showE :: Q Exp- showE | tyName == ''Char# = showPrimE 'C# oneHashE- | tyName == ''Double# = showPrimE 'D# twoHashE- | tyName == ''Float# = showPrimE 'F# oneHashE- | tyName == ''Int# = showPrimE 'I# oneHashE- | tyName == ''Word# = showPrimE 'W# twoHashE- | otherwise = showPrecE `appE` integerE p `appE` tyVarE+ showE =+ case Map.lookup tyName primShowTbl of+ Just ps -> showPrimE ps+ Nothing -> showPrecE `appE` integerE p `appE` tyVarE - -- Starting with GHC 7.10, data types containing unlifted types with derived Show- -- instances show hashed literals with actual hash signs, and negative hashed- -- literals are not surrounded with parentheses.- showPrimE :: Name -> Q Exp -> Q Exp- showPrimE con _hashE-#if __GLASGOW_HASKELL__ >= 711- = infixApp (showPrecE `appE` integerE 0 `appE` (conE con `appE` tyVarE))- [| (<>) |]- _hashE-#else- = showPrecE `appE` integerE p `appE` (conE con `appE` tyVarE)-#endif+ showPrimE :: PrimShow -> Q Exp+ 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)+ where+ primE :: Int -> Q Exp+ primE prec = showPrecE `appE` integerE prec `appE` primShowBoxer tyVarE - oneHashE, twoHashE :: Q Exp- oneHashE = varE (singletonName tsFun) `appE` charE '#'- twoHashE = varE (fromStringName tsFun) `appE` stringE "##" makeTextShowForArg p tsClass tsFun conName tvMap ty tyExpName = [| $(makeTextShowForType tsClass tsFun conName tvMap False ty) p $(varE tyExpName) |] --- | Generates a lambda expression for howbPrec/liftShowbPrec/etc. for a+-- | Generates a lambda expression for showbPrec/liftShowbPrec/etc. for a -- specific type. The generated expression depends on the number of type variables. -- -- 1. If the type is of kind * (T), apply showbPrec.@@ -742,9 +768,8 @@ tyVarNames :: [Name] tyVarNames = Map.keys tvMap - itf <- isTyFamily tyCon- if any (`mentionsName` tyVarNames) lhsArgs- || itf && any (`mentionsName` tyVarNames) tyArgs+ itf <- isInTypeFamilyApp tyVarNames tyCon tyArgs+ if any (`mentionsName` tyVarNames) lhsArgs || itf then outOfPlaceTyVarError tsClass conName else if any (`mentionsName` tyVarNames) rhsArgs then appsE $ [ varE $ showPrecOrListName sl (toEnum numLastArgs) tsFun]@@ -846,17 +871,18 @@ -- instance C (Fam [Char]) remainingTysOrigSubst :: [Type] remainingTysOrigSubst =- map (substNamesWithKindStar (union droppedKindVarNames kvNames'))+ 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' =@@ -873,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.@@ -985,8 +1011,8 @@ -- | Either the given data type doesn't have enough type variables, or one of -- the type variables to be eta-reduced cannot realize kind *.-derivingKindError :: TextShowClass -> Name -> a-derivingKindError tsClass tyConName = error+derivingKindError :: TextShowClass -> Name -> Q a+derivingKindError tsClass tyConName = Monad.fail . showString "Cannot derive well-kinded instance of form ‘" . showString className . showChar ' '@@ -1005,15 +1031,15 @@ -- | One of the last type variables cannot be eta-reduced (see the canEtaReduce -- function for the criteria it would have to meet).-etaReductionError :: Type -> a-etaReductionError instanceType = error $+etaReductionError :: Type -> Q a+etaReductionError instanceType = Monad.fail $ "Cannot eta-reduce to an instance of form \n\tinstance (...) => " ++ pprint instanceType -- | The data type has a DatatypeContext which mentions one of the eta-reduced -- type variables.-datatypeContextError :: Name -> Type -> a-datatypeContextError dataName instanceType = error+datatypeContextError :: Name -> Type -> Q a+datatypeContextError dataName instanceType = Monad.fail . showString "Can't make a derived instance of ‘" . showString (pprint instanceType) . showString "‘:\n\tData type ‘"@@ -1023,8 +1049,8 @@ -- | The data type mentions one of the n eta-reduced type variables in a place other -- than the last nth positions of a data type in a constructor's field.-outOfPlaceTyVarError :: TextShowClass -> Name -> a-outOfPlaceTyVarError tsClass conName = error+outOfPlaceTyVarError :: TextShowClass -> Name -> Q a+outOfPlaceTyVarError tsClass conName = Monad.fail . showString "Constructor ‘" . showString (nameBase conName) . showString "‘ must only use its last "@@ -1037,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@@ -1180,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.@@ -1197,6 +1223,205 @@ catKindVarNames = mapMaybe starKindStatusToName -------------------------------------------------------------------------------+-- PrimShow+-------------------------------------------------------------------------------++data PrimShow = PrimShow+ { primShowBoxer :: Q Exp -> Q Exp+ , primShowPostfixMod :: TextShowFun -> Q Exp+ , primShowConv :: TextShowFun -> Q Exp -> Q Exp+ }++primShowTbl :: Map Name PrimShow+primShowTbl = Map.fromList+ [ (''Char#, PrimShow+ { primShowBoxer = appE (conE 'C#)+ , primShowPostfixMod = oneHashE+ , primShowConv = \_ x -> x+ })+ , (''Double#, PrimShow+ { primShowBoxer = appE (conE 'D#)+ , primShowPostfixMod = twoHashE+ , primShowConv = \_ x -> x+ })+ , (''Float#, PrimShow+ { primShowBoxer = appE (conE 'F#)+ , primShowPostfixMod = oneHashE+ , primShowConv = \_ x -> x+ })+ , (''Int#, PrimShow+ { primShowBoxer = appE (conE 'I#)+ , primShowPostfixMod = oneHashE+ , primShowConv = \_ x -> x+ })+ , (''Word#, PrimShow+ { primShowBoxer = appE (conE 'W#)+ , primShowPostfixMod = twoHashE+ , primShowConv = \_ x -> x+ })+#if MIN_VERSION_base(4,19,0)+ , (''Int8#, PrimShow+ { primShowBoxer = appE (conE 'I8#)+ , primShowPostfixMod = extendedLitE "Int8"+ , primShowConv = \_ x -> x+ })+ , (''Int16#, PrimShow+ { primShowBoxer = appE (conE 'I16#)+ , primShowPostfixMod = extendedLitE "Int16"+ , primShowConv = \_ x -> x+ })+ , (''Int32#, PrimShow+ { primShowBoxer = appE (conE 'I32#)+ , primShowPostfixMod = extendedLitE "Int32"+ , primShowConv = \_ x -> x+ })+ , (''Int64#, PrimShow+ { primShowBoxer = appE (conE 'I64#)+ , primShowPostfixMod = extendedLitE "Int64"+ , primShowConv = \_ x -> x+ })+ , (''Word8#, PrimShow+ { primShowBoxer = appE (conE 'W8#)+ , primShowPostfixMod = extendedLitE "Word8"+ , primShowConv = \_ x -> x+ })+ , (''Word16#, PrimShow+ { primShowBoxer = appE (conE 'W16#)+ , primShowPostfixMod = extendedLitE "Word16"+ , primShowConv = \_ x -> x+ })+ , (''Word32#, PrimShow+ { primShowBoxer = appE (conE 'W32#)+ , primShowPostfixMod = extendedLitE "Word32"+ , primShowConv = \_ x -> x+ })+ , (''Word64#, PrimShow+ { primShowBoxer = appE (conE 'W64#)+ , primShowPostfixMod = extendedLitE "Word64"+ , primShowConv = \_ x -> x+ })+#else+# if MIN_VERSION_base(4,13,0)+ , (''Int8#, PrimShow+ { primShowBoxer = appE (conE 'I#) . appE (varE int8ToIntHashValName)+ , primShowPostfixMod = oneHashE+ , primShowConv = mkNarrowE intToInt8HashValName+ })+ , (''Int16#, PrimShow+ { primShowBoxer = appE (conE 'I#) . appE (varE int16ToIntHashValName)+ , primShowPostfixMod = oneHashE+ , primShowConv = mkNarrowE intToInt16HashValName+ })+ , (''Word8#, PrimShow+ { primShowBoxer = appE (conE 'W#) . appE (varE word8ToWordHashValName)+ , primShowPostfixMod = twoHashE+ , primShowConv = mkNarrowE wordToWord8HashValName+ })+ , (''Word16#, PrimShow+ { primShowBoxer = appE (conE 'W#) . appE (varE word16ToWordHashValName)+ , primShowPostfixMod = twoHashE+ , primShowConv = mkNarrowE wordToWord16HashValName+ })+# endif+# if MIN_VERSION_base(4,16,0)+ , (''Int32#, PrimShow+ { primShowBoxer = appE (conE 'I#) . appE (varE 'int32ToInt#)+ , primShowPostfixMod = oneHashE+ , primShowConv = mkNarrowE 'intToInt32#+ })+ , (''Word32#, PrimShow+ { primShowBoxer = appE (conE 'W#) . appE (varE 'word32ToWord#)+ , primShowPostfixMod = twoHashE+ , primShowConv = mkNarrowE 'wordToWord32#+ })+# endif+#endif+ ]++#if MIN_VERSION_base(4,13,0) && !(MIN_VERSION_base(4,19,0))+mkNarrowE :: Name -> TextShowFun -> Q Exp -> Q Exp+mkNarrowE narrowName tsFun e =+ foldr (`infixApp` [| (<>) |])+ (varE (singletonName tsFun) `appE` charE ')')+ [ varE (fromStringName tsFun) `appE` stringE ('(':nameBase narrowName ++ " ")+ , e+ ]++int8ToIntHashValName :: Name+int8ToIntHashValName =+# if MIN_VERSION_base(4,16,0)+ 'int8ToInt#+# else+ 'extendInt8#+# endif++int16ToIntHashValName :: Name+int16ToIntHashValName =+# if MIN_VERSION_base(4,16,0)+ 'int16ToInt#+# else+ 'extendInt16#+# endif++intToInt8HashValName :: Name+intToInt8HashValName =+# if MIN_VERSION_base(4,16,0)+ 'intToInt8#+# else+ 'narrowInt8#+# endif++intToInt16HashValName :: Name+intToInt16HashValName =+# if MIN_VERSION_base(4,16,0)+ 'intToInt16#+# else+ 'narrowInt16#+# endif++word8ToWordHashValName :: Name+word8ToWordHashValName =+# if MIN_VERSION_base(4,16,0)+ 'word8ToWord#+# else+ 'extendWord8#+# endif++word16ToWordHashValName :: Name+word16ToWordHashValName =+# if MIN_VERSION_base(4,16,0)+ 'word16ToWord#+# else+ 'extendWord16#+# endif++wordToWord8HashValName :: Name+wordToWord8HashValName =+# if MIN_VERSION_base(4,16,0)+ 'wordToWord8#+# else+ 'narrowWord8#+# endif++wordToWord16HashValName :: Name+wordToWord16HashValName =+# if MIN_VERSION_base(4,16,0)+ 'wordToWord16#+# else+ 'narrowWord16#+# endif+#endif++oneHashE, twoHashE :: TextShowFun -> Q Exp+oneHashE tsFun = varE (singletonName tsFun) `appE` charE '#'+twoHashE tsFun = varE (fromStringName tsFun) `appE` stringE "##"++#if MIN_VERSION_base(4,19,0)+extendedLitE :: String -> TextShowFun -> Q Exp+extendedLitE suffix tsFun = varE (fromStringName tsFun) `appE` stringE ("#" ++ suffix)+#endif++------------------------------------------------------------------------------- -- Assorted utilities ------------------------------------------------------------------------------- @@ -1209,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.@@ -1235,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@@ -1264,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:@@ -1309,21 +1522,37 @@ isTyVar (SigT t _) = isTyVar t isTyVar _ = False --- | Is the given type a type family constructor (and not a data family constructor)?-isTyFamily :: Type -> Q Bool-isTyFamily (ConT n) = do- info <- reify n- return $ case info of-#if MIN_VERSION_template_haskell(2,11,0)- FamilyI OpenTypeFamilyD{} _ -> True-#else- FamilyI (FamilyD TypeFam _ _ _) _ -> True-#endif-#if MIN_VERSION_template_haskell(2,9,0)- FamilyI ClosedTypeFamilyD{} _ -> True-#endif- _ -> False-isTyFamily _ = return False+-- | Detect if a Name in a list of provided Names occurs as an argument to some+-- type family. This makes an effort to exclude /oversaturated/ arguments to+-- type families. For instance, if one declared the following type family:+--+-- @+-- type family F a :: Type -> Type+-- @+--+-- Then in the type @F a b@, we would consider @a@ to be an argument to @F@,+-- but not @b@.+isInTypeFamilyApp :: [Name] -> Type -> [Type] -> Q Bool+isInTypeFamilyApp names tyFun tyArgs =+ case tyFun of+ ConT tcName -> go tcName+ _ -> return False+ where+ go :: Name -> Q Bool+ go tcName = do+ info <- reify tcName+ case info of+ FamilyI (OpenTypeFamilyD (TypeFamilyHead _ bndrs _ _)) _+ -> withinFirstArgs bndrs+ FamilyI (ClosedTypeFamilyD (TypeFamilyHead _ bndrs _ _) _) _+ -> withinFirstArgs bndrs+ _ -> return False+ where+ withinFirstArgs :: [a] -> Q Bool+ withinFirstArgs bndrs =+ let firstArgs = take (length bndrs) tyArgs+ argFVs = freeVariables firstArgs+ in return $ any (`elem` argFVs) names -- | Are all of the items in a list (which have an ordering) distinct? --@@ -1343,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@@ -1379,13 +1596,14 @@ -- [Either, Int, Char] -- @ unapplyTy :: Type -> NonEmpty Type-unapplyTy = NE.reverse . go+unapplyTy ty = go ty ty [] where- go :: Type -> NonEmpty Type- go (AppT t1 t2) = t2 <| go t1- go (SigT t _) = go t- go (ForallT _ _ t) = go t- go t = t :| []+ 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+ 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+ go origTy _ args = origTy :| args -- | Split a type signature by the arrows on its spine. For example, this: --@@ -1403,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,15 +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 -- | /Since: 2/+$(deriveTextShow ''Number)++-- | /Since: 2/ $(deriveTextShow ''Lexeme)-#if MIN_VERSION_base(4,6,0)--- | Only available with @base-4.6.0.0@ or later.------ /Since: 2/-$(deriveTextShow numberTypeName)-#endif
src/TextShow/Utils.hs view
@@ -12,8 +12,7 @@ Miscellaneous utility functions. -} module TextShow.Utils (- coerce- , i2d+ i2d , isInfixDataCon , isSymVar , isTupleString@@ -26,36 +25,18 @@ import Data.Int (Int64) import Data.Text (Text)-import Data.Monoid.Compat ((<>)) import Data.Text.Lazy (length, toStrict, unpack) import Data.Text.Lazy.Builder (Builder, singleton, toLazyText) -import GHC.Exts (Char(C#), Int(I#))-import GHC.Prim ((+#), chr#, ord#)+import GHC.Exts (Char(C#), Int(I#), (+#), chr#, ord#) import Prelude () import Prelude.Compat hiding (length) -#if __GLASGOW_HASKELL__ >= 708-import qualified Data.Coerce as C (Coercible, coerce)-#else-import Unsafe.Coerce (unsafeCoerce)-#endif- #if defined(MIN_VERSION_ghc_boot_th) import GHC.Lexeme (startsVarSym) #else import Data.Char (isSymbol, ord)-#endif---- | On GHC 7.8 and later, this is 'C.coerce' from "Data.Coerce". Otherwise, it's--- 'unsafeCoerce'.-#if __GLASGOW_HASKELL__ >= 708-coerce :: C.Coercible a b => a -> b-coerce = C.coerce-#else-coerce :: a -> b-coerce = unsafeCoerce #endif -- | Unsafe conversion for decimal digits.
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@@ -18,16 +15,15 @@ Defines data types with fields that have unlifted types. -}-module Derived.MagicHash (TyCon#(..), TyFamily#(..)) where--#if __GLASGOW_HASKELL__ < 711-import qualified Generics.Deriving.TH as Generics+module Derived.MagicHash (+ TyCon#(..), TyFamily#(..)+#if MIN_VERSION_base(4,13,0)+ , TyCon'#(..), TyFamily'#(..) #endif+ ) where import GHC.Exts-#if __GLASGOW_HASKELL__ >= 711 import GHC.Generics (Generic, Generic1)-#endif import Instances.Utils.GenericArbitrary (genericArbitrary) @@ -36,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) -------------------------------------------------------------------------------@@ -53,12 +47,25 @@ , tcChar# :: Char# , tcWord# :: Word# } deriving ( Show-#if __GLASGOW_HASKELL__ >= 711 , Generic , Generic1-#endif ) +#if MIN_VERSION_base(4,13,0)+data TyCon'# a b = TyCon'# {+ tcA' :: a+ , tcB' :: b+ , tcInt8# :: Int8#+ , tcInt16# :: Int16#+ , tcWord8# :: Word8#+ , tcWord16# :: Word16#+# if MIN_VERSION_base(4,16,0)+ , tcInt32# :: Int32#+ , tcWord32# :: Word32#+# endif+} deriving Show+#endif+ ------------------------------------------------------------------------------- data family TyFamily# y z :: *@@ -72,12 +79,27 @@ , tfChar# :: Char# , tfWord# :: Word# } deriving ( Show-#if __GLASGOW_HASKELL__ >= 711 , Generic , Generic1-#endif ) +#if MIN_VERSION_base(4,13,0)+data family TyFamily'# y z :: *++data instance TyFamily'# a b = TyFamily'# {+ tfA' :: a+ , tfB' :: b+ , tfInt8# :: Int8#+ , tfInt16# :: Int16#+ , tfWord8# :: Word8#+ , tfWord16# :: Word16#+# if MIN_VERSION_base(4,16,0)+ , tfInt32# :: Int32#+ , tfWord32# :: Word32#+# endif+} deriving Show+#endif+ ------------------------------------------------------------------------------- instance (Arbitrary a, Arbitrary b) => Arbitrary (TyCon# a b) where@@ -86,32 +108,95 @@ instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamily# a b) where arbitrary = genericArbitrary +#if MIN_VERSION_base(4,13,0)+instance (Arbitrary a, Arbitrary b) => Arbitrary (TyCon'# a b) where+ arbitrary = do+ a <- arbitrary+ b <- arbitrary+ I# i1 <- arbitrary+ I# i2 <- arbitrary+ W# w1 <- arbitrary+ W# w2 <- arbitrary+# if MIN_VERSION_base(4,16,0)+ I# i3 <- arbitrary+ W# w3 <- arbitrary+# endif+ pure $ TyCon'# a b (intToInt8Compat# i1) (intToInt16Compat# i2)+ (wordToWord8Compat# w1) (wordToWord16Compat# w2)+# if MIN_VERSION_base(4,16,0)+ (intToInt32# i3) (wordToWord32# w3)+# endif++instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamily'# a b) where+ arbitrary = do+ a <- arbitrary+ b <- arbitrary+ I# i1 <- arbitrary+ I# i2 <- arbitrary+ W# w1 <- arbitrary+ W# w2 <- arbitrary+# if MIN_VERSION_base(4,16,0)+ I# i3 <- arbitrary+ W# w3 <- arbitrary+# endif+ pure $ TyFamily'# a b (intToInt8Compat# i1) (intToInt16Compat# i2)+ (wordToWord8Compat# w1) (wordToWord16Compat# w2)+# if MIN_VERSION_base(4,16,0)+ (intToInt32# i3) (wordToWord32# w3)+# endif++# if MIN_VERSION_base(4,16,0)+intToInt8Compat# :: Int# -> Int8#+intToInt8Compat# = intToInt8#++intToInt16Compat# :: Int# -> Int16#+intToInt16Compat# = intToInt16#++wordToWord8Compat# :: Word# -> Word8#+wordToWord8Compat# = wordToWord8#++wordToWord16Compat# :: Word# -> Word16#+wordToWord16Compat# = wordToWord16#+# else+intToInt8Compat# :: Int# -> Int8#+intToInt8Compat# = narrowInt8#++intToInt16Compat# :: Int# -> Int16#+intToInt16Compat# = narrowInt16#++wordToWord8Compat# :: Word# -> Word8#+wordToWord8Compat# = narrowWord8#++wordToWord16Compat# :: Word# -> Word16#+wordToWord16Compat# = narrowWord16#+# endif+#endif+ ------------------------------------------------------------------------------- $(deriveShow1Options legacyShowOptions ''TyCon#)-#if defined(NEW_FUNCTOR_CLASSES)-$(deriveShow2Options legacyShowOptions ''TyCon#)-#endif $(deriveTextShow ''TyCon#) $(deriveTextShow1 ''TyCon#) $(deriveTextShow2 ''TyCon#) -#if __GLASGOW_HASKELL__ < 711-$(Generics.deriveAll0And1 ''TyCon#)-#endif--#if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1Options legacyShowOptions 'TyFamily#)-#else-$(deriveShow1Options legacyShowOptions 'TyFamily#) $(deriveShow2Options legacyShowOptions 'TyFamily#)-#endif $(deriveTextShow 'TyFamily#) $(deriveTextShow1 'TyFamily#) $(deriveTextShow2 'TyFamily#) -#if __GLASGOW_HASKELL__ < 711-$(Generics.deriveAll0And1 'TyFamily#)+#if MIN_VERSION_base(4,13,0)+$(deriveShow1Options legacyShowOptions ''TyCon'#)+$(deriveShow2Options legacyShowOptions ''TyCon'#)+$(deriveTextShow ''TyCon'#)+$(deriveTextShow1 ''TyCon'#)+$(deriveTextShow2 ''TyCon'#)++$(deriveShow1Options legacyShowOptions 'TyFamily'#)+$(deriveShow2Options legacyShowOptions 'TyFamily'#)+$(deriveTextShow 'TyFamily'#)+$(deriveTextShow1 'TyFamily'#)+$(deriveTextShow2 'TyFamily'#) #endif
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)@@ -74,44 +67,32 @@ $(return []) +instance TextShow c => TextShow (Tagged2 s t c) where+ showbPrec = $(makeShowbPrec ''Tagged2)++instance TextShow1 (Tagged2 s t) where+ liftShowbPrec = $(makeLiftShowbPrec ''Tagged2)++instance TextShow2 (Tagged2 s) where+ liftShowbPrec2 = $(makeLiftShowbPrec2 ''Tagged2)++-------------------------------------------------------------------------------+ instance Show1 (Tagged2 s t) where-#if defined(NEW_FUNCTOR_CLASSES) liftShowsPrec = $(makeLiftShowsPrec ''Tagged2)-#else- showsPrec1 = $(makeShowsPrec1 ''Tagged2)-#endif-#if defined(NEW_FUNCTOR_CLASSES) instance Show2 (Tagged2 s) where liftShowsPrec2 = $(makeLiftShowsPrec2 ''Tagged2)-#endif $(deriveShow1 ''TyCon)-#if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2 ''TyCon)-#endif $(deriveTextShow ''TyCon) $(deriveTextShow1 ''TyCon) $(deriveTextShow2 ''TyCon) -#if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 'TyFamily)-#else-$(deriveShow1 'TyFamily) $(deriveShow2 'TyFamily)-#endif $(deriveTextShow 'TyFamily) $(deriveTextShow1 'TyFamily) $(deriveTextShow2 'TyFamily)-----------------------------------------------------------------------------------instance TextShow c => TextShow (Tagged2 s t c) where- showbPrec = $(makeShowbPrec ''Tagged2)--instance TextShow1 (Tagged2 s t) where- liftShowbPrec = $(makeLiftShowbPrec ''Tagged2)--instance TextShow2 (Tagged2 s) where- liftShowbPrec2 = $(makeLiftShowbPrec2 ''Tagged2)
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
@@ -0,0 +1,52 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++{-|+Module: Derived.TypeFamilies+Copyright: (C) 2020 Ryan Scott+License: BSD-style (see the file LICENSE)+Maintainer: Ryan Scott+Stability: Provisional+Portability: GHC++Defines corner case-provoking type families.+-}+module Derived.TypeFamilies (+ TyConOverSat(..)+ , TyFamilyOverSat(..)+ ) where++import Test.QuickCheck (Arbitrary)++import Text.Show.Deriving (deriveShow1, deriveShow2)++import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2)++-------------------------------------------------------------------------------++type family F :: * -> * -> *+type instance F = Either++newtype TyConOverSat a b = TyConOverSat (F a b)+ deriving (Arbitrary, Show)++data family TyFamilyOverSat (x :: *) (y :: *)+newtype instance TyFamilyOverSat a b = TyFamilyOverSat (F a b)+ deriving (Arbitrary, Show)++-------------------------------------------------------------------------------++$(deriveShow1 ''TyConOverSat)+$(deriveShow2 ''TyConOverSat)++$(deriveShow1 'TyFamilyOverSat)+$(deriveShow2 'TyFamilyOverSat)++$(deriveTextShow ''TyConOverSat)+$(deriveTextShow1 ''TyConOverSat)+$(deriveTextShow2 ''TyConOverSat)++$(deriveTextShow 'TyFamilyOverSat)+$(deriveTextShow1 'TyFamilyOverSat)+$(deriveTextShow2 'TyFamilyOverSat)
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,25 +16,17 @@ -} module Derived.TypeSynonyms (TyCon(..), TyFamily(..)) where -#include "generic.h"+import Control.Monad.Trans.Instances () -#if !defined(__LANGUAGE_DERIVE_GENERIC1__)-import qualified Generics.Deriving.TH as Generics-#endif+import Data.Orphans () -import GHC.Generics (Generic)-#if __GLASGOW_HASKELL__ >= 706-import GHC.Generics (Generic1)-#endif+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) @@ -50,10 +36,6 @@ type Id a = a type Flip f a b = f b a --- Needed for the Generic1 instances-instance Functor ((,,,) a b c) where- fmap f (a, b, c, d) = (a, b, c, f d)- ------------------------------------------------------------------------------- newtype TyCon a b = TyCon@@ -65,9 +47,7 @@ deriving ( Arbitrary , Show , Generic-#if __GLASGOW_HASKELL__ >= 706 , Generic1-#endif ) -------------------------------------------------------------------------------@@ -82,52 +62,22 @@ ) deriving ( Arbitrary , Show-#if __GLASGOW_HASKELL__ >= 706 , Generic-# if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1-# endif-#endif ) ------------------------------------------------------------------------------- --- TODO: Replace these with non-orphan instances-$(deriveShow1 ''(,,,))-#if defined(NEW_FUNCTOR_CLASSES)-$(deriveShow2 ''(,,,))-#endif- $(deriveShow1 ''TyCon)-#if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2 ''TyCon)-#endif $(deriveTextShow ''TyCon) $(deriveTextShow1 ''TyCon) $(deriveTextShow2 ''TyCon) -#if __GLASGOW_HASKELL__ < 706-$(Generics.deriveMeta ''TyCon)-$(Generics.deriveRepresentable1 ''TyCon)-#endif--#if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 'TyFamily)-#else-$(deriveShow1 'TyFamily) $(deriveShow2 'TyFamily)-#endif $(deriveTextShow 'TyFamily) $(deriveTextShow1 'TyFamily) $(deriveTextShow2 'TyFamily)--#if !defined(__LANGUAGE_DERIVE_GENERIC1__)-$(Generics.deriveMeta 'TyFamily)-$(Generics.deriveRepresentable1 'TyFamily)-#endif--#if __GLASGOW_HASKELL__ < 706-$(Generics.deriveRepresentable0 'TyFamily)-#endif
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@@ -20,6 +20,9 @@ import GHC.Generics (Generic) import GHC.IO.Exception (IOException(..), IOErrorType(..))+#if MIN_VERSION_base(4,11,0)+import GHC.IO.Exception (FixIOException(..))+#endif import Instances.Foreign.C.Types () import Instances.System.IO ()@@ -52,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@@ -82,19 +83,22 @@ instance Arbitrary BlockedIndefinitelyOnSTM where arbitrary = arbitraryBoundedEnum -#if MIN_VERSION_base(4,8,0) deriving instance Bounded AllocationLimitExceeded deriving instance Enum AllocationLimitExceeded instance Arbitrary AllocationLimitExceeded where arbitrary = arbitraryBoundedEnum-#endif -#if MIN_VERSION_base(4,9,0) deriving instance Arbitrary TypeError-#endif #if MIN_VERSION_base(4,10,0) deriving instance Arbitrary CompactionFailed+#endif++#if MIN_VERSION_base(4,11,0)+deriving instance Bounded FixIOException+deriving instance Enum FixIOException+instance Arbitrary FixIOException where+ arbitrary = arbitraryBoundedEnum #endif deriving instance Bounded Deadlock
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/ByteString.hs
@@ -1,23 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}--{-|-Module: Instances.Data.ByteString-Copyright: (C) 2014-2017 Ryan Scott-License: BSD-style (see the file LICENSE)-Maintainer: Ryan Scott-Stability: Provisional-Portability: GHC--'Arbitrary' instance for 'ShortByteString'.--}-module Instances.Data.ByteString () where--import Data.ByteString.Short (ShortByteString, pack)--import Prelude ()-import Prelude.Compat--import Test.QuickCheck (Arbitrary(..))--instance Arbitrary ShortByteString where- arbitrary = pack <$> arbitrary
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
@@ -0,0 +1,24 @@+{-# LANGUAGE CPP #-}+#if MIN_VERSION_base(4,12,0)+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# OPTIONS_GHC -Wno-orphans #-}+#endif+{-|+Module: Instances.Data.Monoid+Copyright: (C) 2014-2017 Ryan Scott+License: BSD-style (see the file LICENSE)+Maintainer: Ryan Scott+Stability: Provisional+Portability: GHC++'Arbitrary' instance for 'Ap'.+-}+module Instances.Data.Monoid () where++#if MIN_VERSION_base(4,12,0)+import Data.Monoid (Ap(..))+import Test.QuickCheck (Arbitrary)++deriving instance Arbitrary (f a) => Arbitrary (Ap f a)+#endif
− 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 +#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,47 +15,32 @@ -} module Instances.Data.Text () where -import Data.Text.Encoding.Error (UnicodeException(..))-import Data.Text.Foreign (I16)-import Data.Text.Lazy.Builder (Builder, fromString)--#if MIN_VERSION_text(1,0,0) import Data.Text.Encoding (Decoding(..))-import Instances.Utils ((<@>))-#endif--#if MIN_VERSION_text(1,1,0)+import Data.Text.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(..), arbitraryBoundedEnum)+import Test.QuickCheck (Arbitrary(..), getNonNegative) import Test.QuickCheck.Instances () instance Arbitrary Builder where arbitrary = fromString <$> arbitrary -instance Arbitrary I16 where- arbitrary = arbitraryBoundedEnum- instance Arbitrary UnicodeException where arbitrary = genericArbitrary -#if MIN_VERSION_text(1,0,0) instance Arbitrary Decoding where arbitrary = Some <$> arbitrary <*> arbitrary <@> undefined-#endif -#if MIN_VERSION_text(1,1,0) instance Arbitrary Size where arbitrary = exactSize . getNonNegative <$> arbitrary-#endif 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@@ -20,19 +15,12 @@ -} module Instances.Data.Type.Equality () where -#if MIN_VERSION_base(4,7,0)-import Data.Type.Equality ((:~:))-# if MIN_VERSION_base(4,10,0)-import Data.Type.Equality ((:~~:), type (~~))-# endif+import Data.Type.Equality.Compat import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) instance a ~ b => Arbitrary (a :~: b) where arbitrary = arbitraryBoundedEnum -# if MIN_VERSION_base(4,10,0) instance a ~~ b => Arbitrary (a :~~: b) where arbitrary = arbitraryBoundedEnum-# endif-#endif
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,22 +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-import Test.QuickCheck (oneof) #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(..))@@ -81,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@@ -101,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@@ -16,7 +16,9 @@ module Instances.GHC.Fingerprint () where import GHC.Fingerprint.Type (Fingerprint(..))+#if !(MIN_VERSION_base(4,15,0)) import GHC.Generics (Generic)+#endif import Instances.Utils.GenericArbitrary (genericArbitrary) @@ -25,4 +27,6 @@ instance Arbitrary Fingerprint where arbitrary = genericArbitrary +#if !(MIN_VERSION_base(4,15,0)) deriving instance Generic Fingerprint+#endif
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,12 +1,14 @@-{-# LANGUAGE CPP #-}--#if MIN_VERSION_base(4,8,0)+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# 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 {-|@@ -19,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'@@ -31,11 +30,43 @@ 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))+$(Generics.deriveAll0 ''RTSFlags)+$(Generics.deriveAll0 ''GCFlags)+$(Generics.deriveAll0 ''ConcFlags)+$(Generics.deriveAll0 ''MiscFlags)+$(Generics.deriveAll0 ''DebugFlags)+$(Generics.deriveAll0 ''CCFlags)+$(Generics.deriveAll0 ''ProfFlags)+$(Generics.deriveAll0 ''TraceFlags)+$(Generics.deriveAll0 ''TickyFlags)+# if MIN_VERSION_base(4,10,0)+$(Generics.deriveAll0 ''ParFlags)+# endif++$(Generics.deriveAll0 giveGCStatsTypeName)+$(Generics.deriveAll0 doCostCentresTypeName)+$(Generics.deriveAll0 doHeapProfileTypeName)+$(Generics.deriveAll0 doTraceTypeName)+#endif++#if MIN_VERSION_base(4,15,0)+$(Generics.deriveAll0 ''SubSystem.IoSubSystem)+#endif+ instance Arbitrary RTSFlags where arbitrary = genericArbitrary @@ -45,6 +76,17 @@ instance Arbitrary ConcFlags where arbitrary = genericArbitrary +#if MIN_VERSION_base(4,15,0)+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 @@ -63,18 +105,21 @@ 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) type DoTrace' = $(conT doTraceTypeName) --- TODO: Perhaps we should add deriving (Enum, Bounded) to deriving-compat--- and use that instead of Generic? instance Arbitrary GiveGCStats' where arbitrary = genericArbitrary @@ -86,22 +131,3 @@ instance Arbitrary DoTrace' where arbitrary = genericArbitrary--$(Generics.deriveAll0 ''RTSFlags)-$(Generics.deriveAll0 ''GCFlags)-$(Generics.deriveAll0 ''ConcFlags)-$(Generics.deriveAll0 ''MiscFlags)-$(Generics.deriveAll0 ''DebugFlags)-$(Generics.deriveAll0 ''CCFlags)-$(Generics.deriveAll0 ''ProfFlags)-$(Generics.deriveAll0 ''TraceFlags)-$(Generics.deriveAll0 ''TickyFlags)-# if MIN_VERSION_base(4,10,0)-$(Generics.deriveAll0 ''ParFlags)-# endif--$(Generics.deriveAll0 giveGCStatsTypeName)-$(Generics.deriveAll0 doCostCentresTypeName)-$(Generics.deriveAll0 doHeapProfileTypeName)-$(Generics.deriveAll0 doTraceTypeName)-#endif
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,36 +15,27 @@ -} module Instances.GHC.Stack () where -#if MIN_VERSION_base(4,8,1)-import qualified Generics.Deriving.TH as Generics (deriveAll0)-# if MIN_VERSION_base(4,9,0) import GHC.Stack.Types (CallStack(..), SrcLoc(..)) import Instances.Utils ((<@>)) import Test.QuickCheck (oneof)-# else-import GHC.SrcLoc (SrcLoc)-import GHC.Stack (CallStack)-# endif +#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,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--# if !(MIN_VERSION_base(4,9,0))-$(Generics.deriveAll0 ''CallStack)-# endif-$(Generics.deriveAll0 ''SrcLoc)-#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
@@ -1,7 +1,11 @@+{-# LANGUAGE CPP #-}++#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 {-| Module: Instances.GHC.Stats@@ -15,6 +19,7 @@ -} module Instances.GHC.Stats () where +#if !(MIN_VERSION_base(4,11,0)) import GHC.Generics (Generic) import GHC.Stats (GCStats(..)) @@ -25,3 +30,4 @@ deriving instance Generic GCStats instance Arbitrary GCStats where arbitrary = genericArbitrary+#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,36 +14,47 @@ -} 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 case someNatVal nat of Just sn -> pure sn- Nothing -> fail "Negative natural number" -- Should never happen+ Nothing -> error "Negative natural number" -- Should never happen instance Arbitrary SomeSymbol where arbitrary = someSymbolVal <$> arbitrary-#elif MIN_VERSION_base(4,6,0)-instance SingI a => Arbitrary (Sing a) where- arbitrary = pure sing -instance SingI n => Arbitrary (IsZero n) where- arbitrary = pure $ isZero sing+#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
@@ -1,4 +1,12 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+#if __GLASGOW_HASKELL__ >= 806+{-# LANGUAGE DerivingVia #-}+#endif+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Generic@@ -8,16 +16,49 @@ Stability: Provisional Portability: GHC -'Arbitrary' instance for 'ConType'.+Provides instances for 'GenericExample', and an 'Arbitrary' instance for 'ConType'. -} module Instances.Generic () where +import GHC.Generics (Generic, Generic1)+ import Instances.Data.Text ()+import Instances.Utils (GenericExample(..)) import Instances.Utils.GenericArbitrary (genericArbitrary) import Test.QuickCheck (Arbitrary(..)) -import TextShow.Generic (ConType(..))+import Text.Show.Deriving (deriveShow1)++import TextShow (TextShow(..), TextShow1(..))+import TextShow.Generic ( ConType(..)+#if __GLASGOW_HASKELL__ >= 806+ , FromGeneric(..), FromGeneric1(..)+#else+ , genericShowbPrec, genericLiftShowbPrec+#endif+ )++deriving instance Show a => Show (GenericExample a)+$(deriveShow1 ''GenericExample)+instance Arbitrary a => Arbitrary (GenericExample a) where+ arbitrary = genericArbitrary++deriving instance Generic (GenericExample a)+deriving instance Generic1 GenericExample++#if __GLASGOW_HASKELL__ >= 806+deriving via FromGeneric (GenericExample a)+ instance TextShow a => TextShow (GenericExample a)+deriving via FromGeneric1 GenericExample+ instance TextShow1 GenericExample+#else+instance TextShow a => TextShow (GenericExample a) where+ showbPrec = genericShowbPrec++instance TextShow1 GenericExample where+ liftShowbPrec = genericLiftShowbPrec+#endif instance Arbitrary ConType where arbitrary = genericArbitrary
tests/Instances/Options.hs view
@@ -1,6 +1,4 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Options@@ -14,10 +12,12 @@ -} module Instances.Options () where +import Instances.Utils.GenericArbitrary (genericArbitrary) import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) import TextShow.TH (Options(..), GenTextMethods) -deriving instance Arbitrary Options+instance Arbitrary Options where+ arbitrary = genericArbitrary instance Arbitrary GenTextMethods where arbitrary = arbitraryBoundedEnum
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(..))+import Text.Read.Lex (Number) -#if MIN_VERSION_base(4,6,0)-import Language.Haskell.TH.Lib (conT)-import TextShow.TH.Names (numberTypeName)-#endif+$(Generics.deriveAll0 ''Lexeme)+$(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--$(Generics.deriveAll0 ''Lexeme)-#if MIN_VERSION_base(4,6,0)-$(Generics.deriveAll0 numberTypeName)-#endif
tests/Instances/Utils.hs view
@@ -6,9 +6,16 @@ Stability: Provisional Portability: GHC -A collection of utility functions.+A collection of utilities. -}-module Instances.Utils ((<@>)) where+module Instances.Utils (GenericExample(..), (<@>)) where++-- | A simple data type for testing if 'FromGeneric' and+-- 'FromGeneric1' work as intended.+data GenericExample a = GE1 a (Maybe a) (Maybe (Maybe a))+ | GE2+ | GE3 { ge3 :: a }+ | a :!@#$: a infixl 4 <@> -- | A useful way to escape a 'Functor' context.
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
@@ -16,8 +16,6 @@ import Data.Orphans () import Data.Proxy (Proxy(..)) -import Generics.Deriving.Instances ()- import Spec.Utils (matchesTextShowSpec, matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec)
tests/Spec/Control/ExceptionSpec.hs view
@@ -13,6 +13,9 @@ module Spec.Control.ExceptionSpec (main, spec) where import Control.Exception+#if MIN_VERSION_base(4,11,0)+import Control.Exception.Base (FixIOException)+#endif import Data.Proxy (Proxy(..)) import Instances.Control.Exception () import Spec.Utils (matchesTextShowSpec)@@ -33,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" $@@ -47,17 +48,17 @@ matchesTextShowSpec (Proxy :: Proxy BlockedIndefinitelyOnMVar) describe "BlockedIndefinitelyOnSTM" $ matchesTextShowSpec (Proxy :: Proxy BlockedIndefinitelyOnSTM)-#if MIN_VERSION_base(4,8,0) describe "AllocationLimitExceeded" $ matchesTextShowSpec (Proxy :: Proxy AllocationLimitExceeded)-#endif-#if MIN_VERSION_base(4,9,0) describe "TypeError" $ matchesTextShowSpec (Proxy :: Proxy TypeError)-#endif #if MIN_VERSION_base(4,10,0) describe "CompactionFailed" $ matchesTextShowSpec (Proxy :: Proxy CompactionFailed)+#endif+#if MIN_VERSION_base(4,11,0)+ describe "FixIOException" $+ matchesTextShowSpec (Proxy :: Proxy FixIOException) #endif describe "Deadlock" $ matchesTextShowSpec (Proxy :: Proxy Deadlock)
+ 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,7 +18,7 @@ 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 (Proxy(..))@@ -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/ByteStringSpec.hs view
@@ -15,8 +15,6 @@ import Data.ByteString.Short (ShortByteString) import Data.Proxy (Proxy(..)) -import Instances.Data.ByteString ()- import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel)
tests/Spec/Data/EitherSpec.hs view
@@ -11,7 +11,6 @@ module Spec.Data.EitherSpec (main, spec) where import Data.Proxy (Proxy(..))-import Generics.Deriving.Instances () import Spec.Utils (matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel)
tests/Spec/Data/FixedSpec.hs view
@@ -15,7 +15,7 @@ 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
@@ -17,8 +17,8 @@ import Instances.Data.Floating () -import Numeric.Compat (showEFloat, showFFloat, showGFloat,- showFFloatAlt, showGFloatAlt)+import Numeric (showEFloat, showFFloat, showGFloat,+ showFFloatAlt, showGFloatAlt) import Prelude () import Prelude.Compat@@ -27,7 +27,7 @@ import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop)-import Test.QuickCheck (Gen, arbitrary, suchThat)+import Test.QuickCheck (Property, arbitrary, property, suchThat) import TextShow (Builder, fromString) import TextShow.Data.Floating (showbEFloat, showbFFloat, showbGFloat,@@ -57,7 +57,16 @@ -- | Verifies @showXFloat@ and @showbXFloat@ generate the same output (where @X@ -- is one of E, F, or G).-prop_showXFloat :: (Maybe Int -> Double -> ShowS) -> (Maybe Int -> Double -> Builder) -> Double -> Gen Bool-prop_showXFloat f1 f2 val = do- digs <- arbitrary `suchThat` (<= 10)- pure $ fromString (f1 (Just digs) val "") == f2 (Just digs) val+prop_showXFloat :: (Maybe Int -> Double -> ShowS)+ -> (Maybe Int -> Double -> Builder)+ -> Double -> Property+prop_showXFloat f1 f2 val = property $ do+ mb_digs <- arbitrary `suchThat` cond+ pure $ fromString (f1 mb_digs val "") == f2 mb_digs val+ where+ cond :: Maybe Int -> Bool+ cond mb_digs =+ mb_digs /= Nothing && mb_digs <= Just 10+#if !(MIN_VERSION_base(4,12,0))+ && mb_digs > Just 0 -- Work around Trac #15115+#endif
tests/Spec/Data/IntegralSpec.hs view
@@ -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/ListSpec.hs view
@@ -14,7 +14,7 @@ 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/MonoidSpec.hs view
@@ -15,7 +15,7 @@ import Data.Monoid import Data.Proxy (Proxy(..)) -import Generics.Deriving.Instances ()+import Instances.Data.Monoid () import Spec.Utils (matchesTextShowSpec, genericTextShowSpec, genericTextShow1Spec) @@ -66,9 +66,15 @@ 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+#if MIN_VERSION_base(4,12,0)+ describe "Ap Maybe Int" $ do+ let p :: Proxy (Ap Maybe Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p
− 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.Monoid" module.--}-module Spec.Data.OldTypeableSpec (main, spec) where--import Instances.Data.OldTypeable ()--import Prelude ()-import Prelude.Compat--import Test.Hspec (Spec, hspec, parallel)--#if MIN_VERSION_base(4,7,0) && !(MIN_VERSION_base(4,8,0))-import Data.OldTypeable (TyCon, TypeRep)-import Data.Proxy (Proxy(..))--import Spec.Utils (matchesTextShowSpec)--import Test.Hspec (describe)-#endif--main :: IO ()-main = hspec spec--spec :: Spec-spec = parallel $ do-#if MIN_VERSION_base(4,7,0) && !(MIN_VERSION_base(4,8,0))- describe "TypeRep" $- matchesTextShowSpec (Proxy :: Proxy TypeRep)- describe "TyCon" $- matchesTextShowSpec (Proxy :: Proxy TyCon)-#else- pure ()-#endif
tests/Spec/Data/OrdSpec.hs view
@@ -13,8 +13,6 @@ import Data.Orphans () import Data.Proxy (Proxy(..)) -import Generics.Deriving.Instances ()- import GHC.Exts (Down) import Instances.Data.Ord ()
tests/Spec/Data/ProxySpec.hs view
@@ -12,8 +12,6 @@ import Data.Proxy (Proxy(..)) -import Generics.Deriving.Base ()- import Spec.Utils (matchesTextShowSpec, genericTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel)
tests/Spec/Data/SemigroupSpec.hs view
@@ -11,7 +11,7 @@ module Spec.Data.SemigroupSpec (main, spec) where import Data.Proxy (Proxy(..))-import Data.Semigroup (Min, Max, First, Last, WrappedMonoid, Option, Arg)+import Data.Semigroup (Min, Max, First, Last, WrappedMonoid, Arg) import Instances.Data.Semigroup () @@ -35,7 +35,5 @@ matchesTextShowSpec (Proxy :: Proxy (Last Int)) describe "WrappedMonoid ()" $ matchesTextShowSpec (Proxy :: Proxy (WrappedMonoid ()))- describe "Option Int" $- matchesTextShowSpec (Proxy :: Proxy (Option Int)) describe "Arg Int Char" $ matchesTextShowSpec (Proxy :: Proxy (Arg Int Char))
tests/Spec/Data/TextSpec.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE CPP #-}- {-| Module: Spec.Data.TextSpec Copyright: (C) 2014-2017 Ryan Scott@@ -22,14 +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)-import Data.Text.Foreign (I16)-#if MIN_VERSION_text(1,1,0) import Data.Text.Internal.Fusion.Size (Size)-#endif import Data.Text.Lazy.Builder (Builder) main :: IO ()@@ -43,15 +36,9 @@ matchesTextShowSpec (Proxy :: Proxy TS.Text) describe "lazy Text" $ matchesTextShowSpec (Proxy :: Proxy TL.Text)- describe "I16" $- matchesTextShowSpec (Proxy :: Proxy I16) describe "UnicodeException" $ matchesTextShowSpec (Proxy :: Proxy UnicodeException)-#if MIN_VERSION_text(1,0,0) describe "Decoding" $ matchesTextShowSpec (Proxy :: Proxy Decoding)-#endif-#if MIN_VERSION_text(1,1,0) describe "Size" $ matchesTextShowSpec (Proxy :: Proxy Size)-#endif
tests/Spec/Data/TupleSpec.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ {-| Module: Spec.Data.TupleSpec Copyright: (C) 2014-2017 Ryan Scott@@ -11,11 +13,14 @@ module Spec.Data.TupleSpec (main, spec) where import Data.Proxy (Proxy(..))-import Generics.Deriving.Instances ()+#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 (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,6 +12,9 @@ -} module Spec.Data.Type.EqualitySpec (main, spec) where +import Data.Proxy (Proxy(..))+import Data.Type.Equality.Compat+ import Instances.Data.Type.Equality () import Prelude ()@@ -20,29 +22,15 @@ import Test.Hspec (Spec, hspec, parallel) -#if MIN_VERSION_base(4,7,0)-import Data.Proxy (Proxy(..))-import Data.Type.Equality ((:~:))-# if MIN_VERSION_base(4,10,0)-import Data.Type.Equality ((:~~:))-# endif- import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe)-#endif main :: IO () main = hspec spec spec :: Spec spec = parallel $ do-#if MIN_VERSION_base(4,7,0) describe "Int :~: Int" $ matchesTextShowSpec (Proxy :: Proxy (Int :~: Int))-# if MIN_VERSION_base(4,10,0) describe "Int :~~: Int" $ matchesTextShowSpec (Proxy :: Proxy (Int :~~: Int))-# endif-#else- pure ()-#endif
tests/Spec/Data/TypeableSpec.hs view
@@ -1,8 +1,5 @@ {-# LANGUAGE CPP #-}--#if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-}-#endif {-| Module: Spec.Data.TypeableSpec@@ -19,9 +16,7 @@ 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
@@ -5,7 +5,7 @@ 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@@ -18,24 +14,16 @@ 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/MagicHashSpec.hs view
@@ -1,4 +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@@ -14,7 +19,7 @@ import Data.Proxy (Proxy(..)) import Derived.MagicHash-import Spec.Utils (matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec)+import Spec.Utils import Test.Hspec (Spec, describe, hspec, parallel) main :: IO ()@@ -34,3 +39,15 @@ matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p+#if MIN_VERSION_base(4,13,0)+ describe "TyCon'# Int Int" $ do+ let p :: Proxy (TyCon'# Int Int)+ p = Proxy+ matchesTextShowSpec p+ matchesTextShow2Spec p+ describe "TyFamily'# Int Int" $ do+ let p :: Proxy (TyFamily'# Int Int)+ p = Proxy+ matchesTextShowSpec p+ matchesTextShow2Spec p+#endif
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
+ tests/Spec/Derived/TypeFamiliesSpec.hs view
@@ -0,0 +1,32 @@+{-|+Module: Spec.Derived.TypeFamiliesSpec+Copyright: (C) 2020 Ryan Scott+License: BSD-style (see the file LICENSE)+Maintainer: Ryan Scott+Stability: Provisional+Portability: GHC++@hspec@ tests involving corner case-provoking type families.+-}+module Spec.Derived.TypeFamiliesSpec (main, spec) where++import Data.Proxy (Proxy(..))++import Derived.TypeFamilies++import Prelude ()+import Prelude.Compat++import Spec.Utils (matchesTextShow1Spec)++import Test.Hspec (Spec, describe, hspec, parallel)++main :: IO ()+main = hspec spec++spec :: Spec+spec = parallel $ do+ describe "TyConOverSat Int Int" $+ matchesTextShow1Spec (Proxy :: Proxy (TyConOverSat Int Int))+ describe "TyFamilyOverSat Int Int" $+ matchesTextShow1Spec (Proxy :: Proxy (TyFamilyOverSat Int Int))
tests/Spec/FromStringTextShowSpec.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE CPP #-}- {-| Module: Spec.FromStringTextShowSpec Copyright: (C) 2014-2017 Ryan Scott@@ -14,15 +12,12 @@ 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/GHC/Conc/WindowsSpec.hs view
@@ -19,7 +19,7 @@ import Test.Hspec (Spec, hspec, parallel) -#if !defined(__GHCJS__) && defined(mingw32_HOST_OS)+#if !defined(__GHCJS__) && !defined(ghcjs_HOST_OS) && defined(mingw32_HOST_OS) import Data.Proxy (Proxy(..)) import GHC.Conc.Windows (ConsoleEvent) import Spec.Utils (matchesTextShowSpec)@@ -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)+#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/GenericsSpec.hs view
@@ -1,9 +1,5 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE TypeOperators #-}--#if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-}-#endif+{-# LANGUAGE TypeOperators #-} {-| Module: Spec.GHC.GenericsSpec@@ -20,16 +16,12 @@ import Data.Orphans () import Data.Proxy (Proxy(..)) -import Generics.Deriving.Base ( U1, Par1, Rec1, K1, M1, (:+:), (:*:), (:.:)- , UChar, UDouble, UFloat, UInt, UWord- , Fixity, Associativity-#if MIN_VERSION_base(4,9,0)- , Meta(MetaData), SourceUnpackedness- , SourceStrictness, DecidedStrictness-#else- , Arity-#endif- )+import 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,31 +12,37 @@ -} module Spec.GHC.RTS.FlagsSpec (main, spec) where -import Prelude ()-import Prelude.Compat--import Test.Hspec (Spec, hspec, parallel)--#if MIN_VERSION_base(4,8,0) import Data.Proxy (Proxy(..))+ import GHC.RTS.Flags+ import Instances.GHC.RTS.Flags++import 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,21,0)+ describe "IoManagerFlag" $+ matchesTextShowSpec (Proxy :: Proxy IoManagerFlag)+#elif MIN_VERSION_base(4,15,0)+ describe "IoSubSystem" $+ matchesTextShowSpec (Proxy :: Proxy IoSubSystem)+#endif describe "MiscFlags" $ matchesTextShowSpec (Proxy :: Proxy MiscFlags) describe "DebugFlags" $@@ -57,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 (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 (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,4 +1,5 @@-{-# OPTIONS_GHC -fno-warn-deprecations #-}+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -Wno-deprecations #-} {-| Module: Spec.GHC.StatsSpec@@ -12,23 +13,28 @@ -} module Spec.GHC.StatsSpec (main, spec) where -import Data.Proxy (Proxy(..))--import GHC.Stats (GCStats)- import Instances.GHC.Stats () import Prelude () import Prelude.Compat -import Spec.Utils (matchesTextShowSpec)+import Test.Hspec (Spec, hspec, parallel) -import Test.Hspec (Spec, describe, hspec, parallel)+#if !(MIN_VERSION_base(4,11,0))+import Data.Proxy (Proxy(..))+import GHC.Stats (GCStats)+import Spec.Utils (matchesTextShowSpec)+import Test.Hspec (describe)+#endif main :: IO () main = hspec spec spec :: Spec spec = parallel $+#if !(MIN_VERSION_base(4,11,0)) describe "GCStats" $ matchesTextShowSpec (Proxy :: Proxy GCStats)+#else+ pure ()+#endif
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 (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
@@ -12,7 +12,8 @@ import Data.Proxy (Proxy(..)) import Instances.Generic ()-import Spec.Utils (matchesTextShowSpec, genericTextShowSpec)+import Instances.Utils (GenericExample)+import Spec.Utils (matchesTextShowSpec, matchesTextShow1Spec, genericTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) import TextShow.Generic (ConType) @@ -20,8 +21,14 @@ main = hspec spec spec :: Spec-spec = parallel . describe "ConType" $ do- let p :: Proxy ConType- p = Proxy- matchesTextShowSpec p- genericTextShowSpec p+spec = parallel $ do+ describe "ConType" $ do+ let p :: Proxy ConType+ p = Proxy+ matchesTextShowSpec p+ genericTextShowSpec p+ describe "GenericExample Int" $ do+ let p :: Proxy (GenericExample Int)+ p = Proxy+ matchesTextShowSpec p+ matchesTextShow1Spec p
tests/Spec/Text/ReadSpec.hs view
@@ -1,6 +1,3 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE TemplateHaskell #-}- {-| Module: Spec.Text.ReadSpec Copyright: (C) 2014-2017 Ryan Scott@@ -18,11 +15,7 @@ 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.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.6.2+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: .@@ -27,13 +18,30 @@ main = printT (Just \"Hello, World!\") @ .- If you desire it, there are also monomorphic versions of the @showb@- function available in the submodules of "TextShow". See the+ See also the <https://github.com/RyanGlScott/text-show/wiki/Naming-conventions naming conventions>- page for more information.+ page. . Support for automatically deriving @TextShow@ instances can be found in the "TextShow.TH" and "TextShow.Generic" modules.+ .+ @text-show@ only provides instances for data types in the+ following packages:+ .+ * @<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@@ -44,37 +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- , GHC == 8.2.1-extra-source-files: CHANGELOG.md, README.md, include/*.h+tested-with: GHC == 8.0.2+ , GHC == 8.2.2+ , GHC == 8.4.4+ , GHC == 8.6.5+ , GHC == 8.8.4+ , GHC == 8.10.7+ , GHC == 9.0.2+ , GHC == 9.2.8+ , GHC == 9.4.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 developer- description: Operate in developer mode (allows for faster recompilation of tests)- default: False- manual: True--flag base-4-9- description: Use base-4.9 or later.- default: True--flag template-haskell-2-11- description: Use template-haskell-2.11.0.0 or later.- default: True--flag new-functor-classes- description: Use a version of transformers or transformers-compat with a- modern-style Data.Functor.Classes module. This flag cannot be- used when building with transformers-0.4, since it comes with- a different version of Data.Functor.Classes.+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@@ -84,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@@ -112,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@@ -120,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@@ -132,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@@ -156,47 +150,30 @@ TextShow.TH.Internal TextShow.TH.Names TextShow.Utils- build-depends: array >= 0.3 && < 0.6- , base-compat >= 0.8.1 && < 1- , bifunctors >= 5.1 && < 6- , bytestring >= 0.9 && < 0.11- , bytestring-builder- , containers >= 0.1 && < 0.6- , contravariant >= 0.5 && < 2- , generic-deriving >= 1.11 && < 2+ 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- , nats >= 0.1 && < 2- , semigroups >= 0.17 && < 1- , tagged >= 0.4.4 && < 1- , text >= 0.11.1 && < 1.3- , th-abstraction >= 0.2.2 && < 1- , th-lift >= 0.7.6 && < 1- , void >= 0.5 && < 1-- if flag(base-4-9)- build-depends: base >= 4.9 && < 5- cpp-options: "-DNEW_FUNCTOR_CLASSES"- else- build-depends: base >= 4.3 && < 4.9-- if flag(template-haskell-2-11)- build-depends: template-haskell >= 2.11 && < 2.13- , ghc-boot-th >= 8.0 && < 8.3- else- build-depends: template-haskell >= 2.5 && < 2.11+ , 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- include-dirs: include+ if impl(ghc >= 8.6)+ ghc-options: -Wno-star-is-type+ if impl(ghc >= 9.0)+ ghc-options: -fenable-th-splice-warnings test-suite spec type: exitcode-stdio-1.0@@ -209,12 +186,12 @@ Derived.PolyKinds Derived.RankNTypes Derived.Records+ Derived.TypeFamilies Derived.TypeSynonyms Instances.Control.Concurrent Instances.Control.Exception Instances.Control.Monad.ST- Instances.Data.ByteString Instances.Data.Char Instances.Data.Data Instances.Data.Dynamic@@ -224,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@@ -243,21 +226,8 @@ -- Only exports instances if not using Windows Instances.GHC.Event - -- Only exports instances if base >= 4.6- Instances.GHC.TypeLits-- -- Only exports instances if base >= 4.7- Instances.Data.Type.Coercion- Instances.Data.Type.Equality- -- Only exports instances if base >= 4.7 && < 4.8- Instances.Data.OldTypeable-- -- Only exports instances if base >= 4.8- Instances.GHC.RTS.Flags- Instances.GHC.StaticPtr-- -- Only exports instances if base >= 4.9- Instances.GHC.Stack+ -- Only exports instances if base >= 4.12+ Instances.Data.Monoid Spec.BuilderSpec Spec.Control.ApplicativeSpec@@ -265,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@@ -289,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@@ -299,6 +272,7 @@ Spec.Derived.PolyKindsSpec Spec.Derived.RankNTypesSpec Spec.Derived.RecordsSpec+ Spec.Derived.TypeFamiliesSpec Spec.Derived.TypeSynonymsSpec Spec.Foreign.C.TypesSpec Spec.Foreign.PtrSpec@@ -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,124 +299,41 @@ -- 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- build-depends: array >= 0.3 && < 0.6- , base-compat >= 0.8.2 && < 1- , base-orphans >= 0.6 && < 0.7- , bifunctors >= 5.1 && < 6- , bytestring >= 0.9 && < 0.11- , bytestring-builder- , containers >= 0.1 && < 0.6- , contravariant >= 0.5 && < 2- , deriving-compat >= 0.3.4 && < 1- , generic-deriving >= 1.11 && < 2+ TextShow.TH.Names+ 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- , integer-gmp- , nats >= 0.1 && < 2- , QuickCheck >= 2.10 && < 2.11- , quickcheck-instances >= 0.3.16 && < 0.4- , semigroups >= 0.18.3 && < 1- , tagged >= 0.8.3 && < 1- , text >= 0.11.1 && < 1.3- , th-lift >= 0.7.6 && < 1- , transformers-compat >= 0.5 && < 1- , void >= 0.5 && < 1-- if flag(base-4-9)- build-depends: base >= 4.9 && < 5- cpp-options: "-DNEW_FUNCTOR_CLASSES"- else- build-depends: base >= 4.3 && < 4.9-- if flag(template-haskell-2-11)- build-depends: template-haskell >= 2.11 && < 2.13- , ghc-boot-th >= 8.0 && < 8.3- else- build-depends: template-haskell >= 2.5 && < 2.11-- if flag(new-functor-classes)- build-depends: transformers (>= 0.2.1 && < 0.4) || (>= 0.5 && < 0.6)- cpp-options: "-DNEW_FUNCTOR_CLASSES"- else- build-depends: transformers == 0.4.*-- if flag(developer)- hs-source-dirs: src- else- build-depends: text-show+ , 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+ build-tool-depends: hspec-discover:hspec-discover hs-source-dirs: tests, shared default-language: Haskell2010 ghc-options: -Wall -threaded -rtsopts- include-dirs: include- includes: generic.h- , overlap.h+ if impl(ghc >= 8.6)+ ghc-options: -Wno-star-is-type+ if impl(ghc >= 9.0)+ ghc-options: -fenable-th-splice-warnings benchmark bench- if impl(ghc < 7.4)- buildable: False- type: exitcode-stdio-1.0 main-is: Bench.hs- build-depends: array >= 0.3 && < 0.6- , base-compat >= 0.8.1 && < 1- , bifunctors >= 5.1 && < 6- , bytestring >= 0.9 && < 0.11- , bytestring-builder- , containers >= 0.1 && < 0.6- , contravariant >= 0.5 && < 2- , criterion >= 1.1.4 && < 2- , deepseq >= 1.3 && < 2- , generic-deriving >= 1.11 && < 2- , ghc-prim- , integer-gmp- , nats >= 0.1 && < 2- , semigroups >= 0.17 && < 1- , tagged >= 0.4.4 && < 1- , text >= 0.11.1 && < 1.3- , th-lift >= 0.7.6 && < 1- , void >= 0.5 && < 1-- if flag(base-4-9)- build-depends: base >= 4.9 && < 5- cpp-options: "-DNEW_FUNCTOR_CLASSES"- else- build-depends: base >= 4.5 && < 4.9-- if flag(template-haskell-2-11)- build-depends: template-haskell >= 2.11 && < 2.13- , ghc-boot-th >= 8.0 && < 8.3- else- build-depends: template-haskell >= 2.5 && < 2.11-- if flag(new-functor-classes)- build-depends: transformers (>= 0.2.1 && < 0.4) || (>= 0.5 && < 0.6)- , transformers-compat >= 0.5 && < 1- cpp-options: "-DNEW_FUNCTOR_CLASSES"- else- build-depends: transformers == 0.4.*-- if flag(developer)- hs-source-dirs: src- else- build-depends: text-show+ build-depends: base >= 4.9 && < 4.23+ , criterion >= 1.1.4 && < 2+ , deepseq >= 1.3 && < 2+ , text-show+ , text >= 1.1 && < 2.2 - hs-source-dirs: benchmarks, shared+ hs-source-dirs: benchmarks default-language: Haskell2010 ghc-options: -Wall- include-dirs: include