diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,128 @@ +### 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.*`. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,10 +1,8 @@ # `text-show` [![Hackage](https://img.shields.io/hackage/v/text-show.svg)][Hackage: text-show] -[![Hackage Dependencies](https://img.shields.io/hackage-deps/v/text-show.svg)](http://packdeps.haskellers.com/reverse/text-show) [![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-blue.svg)][Haskell.org] [![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg)][tl;dr Legal: BSD3] -[![Linux build](https://github.com/RyanGlScott/text-show/workflows/Haskell-CI/badge.svg)](https://github.com/RyanGlScott/text-show/actions?query=workflow%3AHaskell-CI) -[![Windows build](https://ci.appveyor.com/api/projects/status/fy1q86lbfttmnthy?svg=true)](https://ci.appveyor.com/project/RyanGlScott/text-show) +[![Build Status](https://github.com/RyanGlScott/text-show/workflows/Haskell-CI/badge.svg)](https://github.com/RyanGlScott/text-show/actions?query=workflow%3AHaskell-CI) [Hackage: text-show]: http://hackage.haskell.org/package/text-show @@ -18,8 +16,6 @@ `text-show` offers a replacement for the `Show` typeclass intended for use with `Text` instead of `String`s. This package was created in the spirit of [`bytestring-show`](http://hackage.haskell.org/package/bytestring-show). -At the moment, `text-show` provides instances for most data types in the [`array`](http://hackage.haskell.org/package/array), [`base`](http://hackage.haskell.org/package/base), [`bytestring`](http://hackage.haskell.org/package/bytestring), and [`text`](http://hackage.haskell.org/package/text) packages. Therefore, much of the source code for `text-show` consists of borrowed code from those packages in order to ensure that the behaviors of `Show` and `TextShow` coincide. - For most uses, simply importing `TextShow` will suffice: ```haskell @@ -34,3 +30,18 @@ See also the [naming conventions](https://github.com/RyanGlScott/text-show/wiki/Naming-conventions) page. Support for automatically deriving `TextShow` instances can be found in the `TextShow.TH` and `TextShow.Generic` modules. + +## Scope of the library + +`text-show` only provides instances for data types in the following packages: + +* [`array`](http://hackage.haskell.org/package/array) +* [`base`](http://hackage.haskell.org/package/base) +* [`bytestring`](http://hackage.haskell.org/package/bytestring) +* [`text`](http://hackage.haskell.org/package/text) + +This policy is in place to keep `text-show`'s dependencies reasonably light. If +you need a `TextShow` instance for a library that is not in this list, it may +be covered by the +[`text-show-instances`](https://github.com/RyanGlScott/text-show-instances) +library. diff --git a/benchmarks/Bench.hs b/benchmarks/Bench.hs --- a/benchmarks/Bench.hs +++ b/benchmarks/Bench.hs @@ -18,7 +18,7 @@ import Criterion.Main (Benchmark, bench, bgroup, defaultMain, nf) -import Data.List (foldl') +import qualified Data.Foldable as F import qualified Data.Text as T import GHC.Generics (Generic) @@ -121,12 +121,12 @@ mediumSample :: Sample mediumSample (leaf, branch, empty, showFun) = - showFun . foldl' branch empty . replicate 1000 $ sampleTree leaf branch + showFun . F.foldl' branch empty . replicate 1000 $ sampleTree leaf branch {-# NOINLINE mediumSample #-} largeSample :: Sample largeSample (leaf, branch, empty, showFun) = - showFun . foldl' branch empty . replicate 100000 $ sampleTree leaf branch + showFun . F.foldl' branch empty . replicate 100000 $ sampleTree leaf branch {-# NOINLINE largeSample #-} sampleTree :: (Int -> a) -> (a -> a -> a) -> a diff --git a/include/generic.h b/include/generic.h deleted file mode 100644 --- a/include/generic.h +++ /dev/null @@ -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 diff --git a/include/overlap.h b/include/overlap.h deleted file mode 100644 --- a/include/overlap.h +++ /dev/null @@ -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 diff --git a/shared/TextShow/TH/Names.hs b/shared/TextShow/TH/Names.hs --- a/shared/TextShow/TH/Names.hs +++ b/shared/TextShow/TH/Names.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskellQuotes #-} {-| Module: TextShow.TH.Names @@ -17,25 +17,22 @@ fdKeyTypeName, uniqueTypeName, asInt64ValName, -#if MIN_VERSION_base(4,8,0) giveGCStatsTypeName, doCostCentresTypeName, doHeapProfileTypeName, doTraceTypeName, -#endif ) where -import Language.Haskell.TH.Syntax - -#if MIN_VERSION_base(4,8,2) import GHC.RTS.Flags (GiveGCStats, DoCostCentres, DoHeapProfile, DoTrace) -#endif +import Language.Haskell.TH.Syntax ------------------------------------------------------------------------------- -- | Creates a 'Name' for a value from the "GHC.Event.Internal" module. mkEventName_v :: String -> Name -#if MIN_VERSION_base(4,15,0) +#if MIN_VERSION_base(4,20,0) +mkEventName_v = mkNameG_v "ghc-internal" "GHC.Internal.Event.Internal.Types" +#elif MIN_VERSION_base(4,15,0) mkEventName_v = mkNameG_v "base" "GHC.Event.Internal.Types" #else mkEventName_v = mkNameG_v "base" "GHC.Event.Internal" @@ -51,56 +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,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 diff --git a/src/TextShow/Classes.hs b/src/TextShow/Classes.hs --- a/src/TextShow/Classes.hs +++ b/src/TextShow/Classes.hs @@ -1,7 +1,10 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} + +#if __GLASGOW_HASKELL__ >= 806 +{-# LANGUAGE QuantifiedConstraints #-} +#endif + {-| Module: TextShow.Classes Copyright: (C) 2014-2017 Ryan Scott @@ -14,7 +17,6 @@ -} module TextShow.Classes where -import Data.Data (Typeable) 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) @@ -172,8 +174,6 @@ {-# MINIMAL showbPrec | showb #-} -deriving instance Typeable TextShow - -- | Surrounds 'Builder' output with parentheses if the 'Bool' parameter is 'True'. -- -- /Since: 2/ @@ -392,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. -- @@ -412,8 +416,6 @@ {-# MINIMAL liftShowbPrec #-} -deriving instance Typeable TextShow1 - -- | Lift the standard 'showbPrec' and 'showbList' functions through the -- type constructor. -- @@ -457,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. -- @@ -479,8 +495,6 @@ showbListWith (liftShowbPrec2 sp1 sl1 sp2 sl2 0) {-# MINIMAL liftShowbPrec2 #-} - -deriving instance Typeable TextShow2 -- | Lift two 'showbPrec' functions through the type constructor. -- diff --git a/src/TextShow/Control/Applicative.hs b/src/TextShow/Control/Applicative.hs --- a/src/TextShow/Control/Applicative.hs +++ b/src/TextShow/Control/Applicative.hs @@ -3,7 +3,7 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Control.Applicative Copyright: (C) 2014-2017 Ryan Scott diff --git a/src/TextShow/Control/Concurrent.hs b/src/TextShow/Control/Concurrent.hs --- a/src/TextShow/Control/Concurrent.hs +++ b/src/TextShow/Control/Concurrent.hs @@ -3,7 +3,7 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE UnliftedFFITypes #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Control.Concurrent Copyright: (C) 2014-2017 Ryan Scott diff --git a/src/TextShow/Control/Exception.hs b/src/TextShow/Control/Exception.hs --- a/src/TextShow/Control/Exception.hs +++ b/src/TextShow/Control/Exception.hs @@ -5,7 +5,7 @@ #if __GLASGOW_HASKELL__ >= 806 {-# LANGUAGE DerivingVia #-} #endif -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Control.Exception Copyright: (C) 2014-2017 Ryan Scott @@ -23,7 +23,7 @@ import Control.Exception.Base import Data.Text.Lazy.Builder (fromString) -#if MIN_VERSION_base(4,9,0) +#if !MIN_VERSION_base(4,21,0) import Data.Text.Lazy.Builder (singleton) #endif @@ -111,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. @@ -177,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/ diff --git a/src/TextShow/Control/Monad/ST.hs b/src/TextShow/Control/Monad/ST.hs --- a/src/TextShow/Control/Monad/ST.hs +++ b/src/TextShow/Control/Monad/ST.hs @@ -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 diff --git a/src/TextShow/Data/Array.hs b/src/TextShow/Data/Array.hs --- a/src/TextShow/Data/Array.hs +++ b/src/TextShow/Data/Array.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Array Copyright: (C) 2014-2017 Ryan Scott @@ -34,10 +34,6 @@ import TextShow.Data.List () import TextShow.Data.Tuple () -{-# SPECIALIZE - showbIArrayPrec :: (IArray UArray e, Ix i, TextShow i, TextShow e) => - Int -> UArray i e -> Builder - #-} -- | Convert an 'IArray' instance to a 'Builder' with the given precedence. -- -- /Since: 2/ diff --git a/src/TextShow/Data/Array/Byte.hs b/src/TextShow/Data/Array/Byte.hs new file mode 100644 --- /dev/null +++ b/src/TextShow/Data/Array/Byte.hs @@ -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 diff --git a/src/TextShow/Data/Bool.hs b/src/TextShow/Data/Bool.hs --- a/src/TextShow/Data/Bool.hs +++ b/src/TextShow/Data/Bool.hs @@ -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 diff --git a/src/TextShow/Data/ByteString.hs b/src/TextShow/Data/ByteString.hs --- a/src/TextShow/Data/ByteString.hs +++ b/src/TextShow/Data/ByteString.hs @@ -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 diff --git a/src/TextShow/Data/Char.hs b/src/TextShow/Data/Char.hs --- a/src/TextShow/Data/Char.hs +++ b/src/TextShow/Data/Char.hs @@ -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 diff --git a/src/TextShow/Data/Complex.hs b/src/TextShow/Data/Complex.hs --- a/src/TextShow/Data/Complex.hs +++ b/src/TextShow/Data/Complex.hs @@ -1,6 +1,6 @@ {-# 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 #-} diff --git a/src/TextShow/Data/Data.hs b/src/TextShow/Data/Data.hs --- a/src/TextShow/Data/Data.hs +++ b/src/TextShow/Data/Data.hs @@ -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 diff --git a/src/TextShow/Data/Dynamic.hs b/src/TextShow/Data/Dynamic.hs --- a/src/TextShow/Data/Dynamic.hs +++ b/src/TextShow/Data/Dynamic.hs @@ -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 diff --git a/src/TextShow/Data/Either.hs b/src/TextShow/Data/Either.hs --- a/src/TextShow/Data/Either.hs +++ b/src/TextShow/Data/Either.hs @@ -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 diff --git a/src/TextShow/Data/Fixed.hs b/src/TextShow/Data/Fixed.hs --- a/src/TextShow/Data/Fixed.hs +++ b/src/TextShow/Data/Fixed.hs @@ -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 @@ -16,7 +16,7 @@ import Data.Fixed (Fixed(..), HasResolution(..)) import Data.Int (Int64) -import Data.Semigroup.Compat (mtimesDefault) +import Data.Semigroup (mtimesDefault) import Data.Text.Lazy.Builder (Builder, singleton) import Prelude () @@ -44,12 +44,8 @@ (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 -- | Only works for positive 'Integer's. showbIntegerZeroes :: Bool -> Int64 -> Integer -> Builder diff --git a/src/TextShow/Data/Floating.hs b/src/TextShow/Data/Floating.hs --- a/src/TextShow/Data/Floating.hs +++ b/src/TextShow/Data/Floating.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Floating Copyright: (C) 2014-2017 Ryan Scott @@ -71,15 +71,12 @@ | otherwise = showbGFloat Nothing x {-# INLINE showbRealFloatPrec #-} -{-# SPECIALIZE showbEFloat :: - Maybe Int -> Float -> Builder, - Maybe Int -> Double -> Builder #-} -{-# SPECIALIZE showbFFloat :: - Maybe Int -> Float -> Builder, - Maybe Int -> Double -> Builder #-} -{-# SPECIALIZE showbGFloat :: - Maybe Int -> Float -> Builder, - Maybe Int -> Double -> Builder #-} +{-# SPECIALIZE showbEFloat :: Maybe Int -> Float -> Builder #-} +{-# SPECIALIZE showbEFloat :: Maybe Int -> Double -> Builder #-} +{-# SPECIALIZE showbFFloat :: Maybe Int -> Float -> Builder #-} +{-# SPECIALIZE showbFFloat :: Maybe Int -> Double -> Builder #-} +{-# SPECIALIZE showbGFloat :: Maybe Int -> Float -> Builder #-} +{-# SPECIALIZE showbGFloat :: Maybe Int -> Double -> Builder #-} -- | Show a signed 'RealFloat' value -- using scientific (exponential) notation (e.g. @2.45e2@, @1.5e-3@). diff --git a/src/TextShow/Data/Functor/Compose.hs b/src/TextShow/Data/Functor/Compose.hs --- a/src/TextShow/Data/Functor/Compose.hs +++ b/src/TextShow/Data/Functor/Compose.hs @@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Functor.Compose diff --git a/src/TextShow/Data/Functor/Identity.hs b/src/TextShow/Data/Functor/Identity.hs --- a/src/TextShow/Data/Functor/Identity.hs +++ b/src/TextShow/Data/Functor/Identity.hs @@ -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 diff --git a/src/TextShow/Data/Functor/Product.hs b/src/TextShow/Data/Functor/Product.hs --- a/src/TextShow/Data/Functor/Product.hs +++ b/src/TextShow/Data/Functor/Product.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Functor.Product diff --git a/src/TextShow/Data/Functor/Sum.hs b/src/TextShow/Data/Functor/Sum.hs --- a/src/TextShow/Data/Functor/Sum.hs +++ b/src/TextShow/Data/Functor/Sum.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Functor.Sum diff --git a/src/TextShow/Data/Integral.hs b/src/TextShow/Data/Integral.hs --- a/src/TextShow/Data/Integral.hs +++ b/src/TextShow/Data/Integral.hs @@ -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 diff --git a/src/TextShow/Data/List.hs b/src/TextShow/Data/List.hs --- a/src/TextShow/Data/List.hs +++ b/src/TextShow/Data/List.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.List Copyright: (C) 2014-2017 Ryan Scott diff --git a/src/TextShow/Data/List/NonEmpty.hs b/src/TextShow/Data/List/NonEmpty.hs --- a/src/TextShow/Data/List/NonEmpty.hs +++ b/src/TextShow/Data/List/NonEmpty.hs @@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.List.NonEmpty @@ -15,7 +15,7 @@ -} module TextShow.Data.List.NonEmpty () where -import Data.List.NonEmpty.Compat (NonEmpty) +import Data.List.NonEmpty (NonEmpty) import TextShow.Data.List () import TextShow.TH.Internal (deriveTextShow, deriveTextShow1) diff --git a/src/TextShow/Data/Maybe.hs b/src/TextShow/Data/Maybe.hs --- a/src/TextShow/Data/Maybe.hs +++ b/src/TextShow/Data/Maybe.hs @@ -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 diff --git a/src/TextShow/Data/Monoid.hs b/src/TextShow/Data/Monoid.hs --- a/src/TextShow/Data/Monoid.hs +++ b/src/TextShow/Data/Monoid.hs @@ -1,9 +1,7 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE TemplateHaskell #-} -#if MIN_VERSION_base(4,8,0) {-# LANGUAGE FlexibleContexts #-} -#endif -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Monoid Copyright: (C) 2014-2017 Ryan Scott @@ -18,17 +16,12 @@ -} module TextShow.Data.Monoid () where -import Data.Monoid.Compat (All, Any, Dual, First, Last, Product, Sum) +import Data.Monoid (All, Alt, Any, Dual, First, Last, Product, Sum) +import TextShow.Classes (TextShow(..)) import TextShow.Data.Bool () import TextShow.Data.Maybe () -import TextShow.TH.Internal (deriveTextShow, deriveTextShow1) - -#if MIN_VERSION_base(4,8,0) -import Data.Monoid (Alt) -import TextShow.Classes (TextShow(..)) -import TextShow.TH.Internal (makeShowbPrec) -#endif +import TextShow.TH.Internal (deriveTextShow, deriveTextShow1, makeShowbPrec) #if MIN_VERSION_base(4,12,0) import Data.Monoid (Ap) @@ -59,18 +52,12 @@ -- | /Since: 2/ $(deriveTextShow1 ''Sum) -#if MIN_VERSION_base(4,8,0) --- | Only available with @base-4.8.0.0@ or later. --- --- /Since: 2/ +-- | /Since: 2/ instance TextShow (f a) => TextShow (Alt f a) where showbPrec = $(makeShowbPrec ''Alt) --- | Only available with @base-4.8.0.0@ or later. --- --- /Since: 2/ +-- | /Since: 2/ $(deriveTextShow1 ''Alt) -#endif #if MIN_VERSION_base(4,12,0) -- | Only available with @base-4.12.0.0@ or later. diff --git a/src/TextShow/Data/OldTypeable.hs b/src/TextShow/Data/OldTypeable.hs deleted file mode 100644 --- a/src/TextShow/Data/OldTypeable.hs +++ /dev/null @@ -1,60 +0,0 @@ -{-# LANGUAGE CPP #-} - -#if !(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,8,0)) -import Data.OldTypeable.Internal (TyCon(TyCon, tyConName), TypeRep(..), - funTc, listTc) -import Data.Text.Lazy.Builder (fromString, singleton) - -import Prelude () -import Prelude.Compat - -import TextShow.Classes (TextShow(..), showbParen, showbSpace) -import TextShow.Data.Typeable.Utils (showbArgs, showbTuple) -import TextShow.Utils (isTupleString) - --- | Does the 'TyCon' represent a tuple type constructor? -isTupleTyCon :: TyCon -> Bool -isTupleTyCon (TyCon _ _ _ str) = isTupleString str -{-# INLINE isTupleTyCon #-} - --- | /Since: 2/ -instance TextShow TyCon where - showb = fromString . tyConName - {-# INLINE showb #-} - --- | /Since: 2/ -instance TextShow TypeRep where - showbPrec p (TypeRep _ tycon tys) = - case tys of - [] -> showb tycon - [x] | tycon == listTc -> singleton '[' <> showb x <> singleton ']' - [a,r] | tycon == funTc -> showbParen (p > 8) $ - showbPrec 9 a - <> " -> " - <> showbPrec 8 r - xs | isTupleTyCon tycon -> showbTuple xs - | otherwise -> showbParen (p > 9) $ - showbPrec p tycon - <> showbSpace - <> showbArgs showbSpace tys - {-# INLINE showbPrec #-} -#endif diff --git a/src/TextShow/Data/Ord.hs b/src/TextShow/Data/Ord.hs --- a/src/TextShow/Data/Ord.hs +++ b/src/TextShow/Data/Ord.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Ord Copyright: (C) 2014-2017 Ryan Scott diff --git a/src/TextShow/Data/Proxy.hs b/src/TextShow/Data/Proxy.hs --- a/src/TextShow/Data/Proxy.hs +++ b/src/TextShow/Data/Proxy.hs @@ -3,7 +3,7 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Proxy @@ -19,7 +19,7 @@ -} module TextShow.Data.Proxy () where -import Data.Proxy.Compat (Proxy) +import Data.Proxy (Proxy) import TextShow.Classes (TextShow(..)) import TextShow.TH.Internal (deriveTextShow1, makeShowbPrec, diff --git a/src/TextShow/Data/Ratio.hs b/src/TextShow/Data/Ratio.hs --- a/src/TextShow/Data/Ratio.hs +++ b/src/TextShow/Data/Ratio.hs @@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Ratio diff --git a/src/TextShow/Data/Semigroup.hs b/src/TextShow/Data/Semigroup.hs --- a/src/TextShow/Data/Semigroup.hs +++ b/src/TextShow/Data/Semigroup.hs @@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Semigroup @@ -15,7 +15,7 @@ -} module TextShow.Data.Semigroup () where -import Data.Semigroup.Compat (Min, Max, First, Last, WrappedMonoid, Arg) +import Data.Semigroup (Min, Max, First, Last, WrappedMonoid, Arg) import TextShow.Data.Maybe () import TextShow.TH.Internal (deriveTextShow, deriveTextShow1, deriveTextShow2) diff --git a/src/TextShow/Data/Text.hs b/src/TextShow/Data/Text.hs --- a/src/TextShow/Data/Text.hs +++ b/src/TextShow/Data/Text.hs @@ -1,10 +1,7 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -#if MIN_VERSION_text(0,9,0) {-# LANGUAGE TemplateHaskell #-} -#endif -{-# OPTIONS_GHC -fno-warn-deprecations #-} -- TODO: Remove this later -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-deprecations #-} -- TODO: Remove this later +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Text Copyright: (C) 2014-2017 Ryan Scott @@ -26,30 +23,24 @@ module TextShow.Data.Text () where import qualified Data.Text as TS +import Data.Text.Encoding (Decoding(..)) import Data.Text.Encoding.Error (UnicodeException(..)) +import Data.Text.Internal.Fusion.Size (Size) import qualified Data.Text.Lazy as TL -import Data.Text.Lazy.Builder (Builder, fromString, toLazyText) +import Data.Text.Lazy.Builder (Builder, fromString, singleton, + toLazyText) +import GHC.Show (appPrec) + import Prelude () import Prelude.Compat -import TextShow.Classes (TextShow(..)) +import TextShow.Classes (TextShow(..), showbParen) +import TextShow.Data.ByteString () import TextShow.Data.Char (showbString) import TextShow.Data.Integral (showbHex) import TextShow.TH.Internal (deriveTextShow) -#if MIN_VERSION_text(1,0,0) -import Data.Text.Encoding (Decoding(..)) -import Data.Text.Lazy.Builder (singleton) -import GHC.Show (appPrec) -import TextShow.Classes (showbParen) -import TextShow.Data.ByteString () -#endif - -#if MIN_VERSION_text(1,1,0) -import Data.Text.Internal.Fusion.Size (Size) -#endif - -- | /Since: 2/ instance TextShow TS.Text where showb = showbString . TS.unpack @@ -76,21 +67,13 @@ showb (EncodeError desc Nothing) = "Cannot encode input: " <> fromString desc -#if MIN_VERSION_text(1,0,0) --- | Only available with @text-1.0.0.0@ or later. --- --- /Since: 2/ +-- | /Since: 2/ instance TextShow Decoding where showbPrec p (Some t bs _) = showbParen (p > appPrec) $ "Some " <> showb t <> singleton ' ' <> showb bs <> " _" {-# INLINE showbPrec #-} -#endif -#if MIN_VERSION_text(1,1,0) --- | Only available with @text-1.1.0.0@ or later. --- --- /Since: 2/ +-- | /Since: 2/ $(deriveTextShow ''Size) -#endif diff --git a/src/TextShow/Data/Tuple.hs b/src/TextShow/Data/Tuple.hs --- a/src/TextShow/Data/Tuple.hs +++ b/src/TextShow/Data/Tuple.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Tuple Copyright: (C) 2014-2017 Ryan Scott @@ -122,6 +122,10 @@ -- | /Since: 3.9.3/ instance TextShow1 Solo where - liftShowbPrec sp _ p (Solo x) = showbUnaryWith sp "Solo" p x +# 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 diff --git a/src/TextShow/Data/Type/Coercion.hs b/src/TextShow/Data/Type/Coercion.hs --- a/src/TextShow/Data/Type/Coercion.hs +++ b/src/TextShow/Data/Type/Coercion.hs @@ -1,7 +1,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Type.Coercion Copyright: (C) 2014-2017 Ryan Scott diff --git a/src/TextShow/Data/Type/Equality.hs b/src/TextShow/Data/Type/Equality.hs --- a/src/TextShow/Data/Type/Equality.hs +++ b/src/TextShow/Data/Type/Equality.hs @@ -1,9 +1,8 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Type.Equality Copyright: (C) 2014-2017 Ryan Scott @@ -33,7 +32,6 @@ -- | /Since: 2/ $(deriveTextShow2 ''(:~:)) -#if MIN_VERSION_base(4,9,0) -- | /Since: 3.6/ $(deriveTextShow ''(:~~:)) @@ -43,4 +41,3 @@ -- | /Since: 3.6/ $(deriveTextShow2 ''(:~~:)) -#endif diff --git a/src/TextShow/Data/Typeable.hs b/src/TextShow/Data/Typeable.hs --- a/src/TextShow/Data/Typeable.hs +++ b/src/TextShow/Data/Typeable.hs @@ -10,7 +10,7 @@ {-# LANGUAGE TypeApplications #-} #endif -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Typeable @@ -38,43 +38,42 @@ import GHC.Types (Module(..), TrName(..), TyCon(..), isTrue#) import TextShow.Classes (TextShow(..), TextShow1(..), showbParen, showbSpace) -import TextShow.Data.Typeable.Utils (showbArgs, showbTuple) -import TextShow.Utils (isTupleString) +import TextShow.Data.Typeable.Utils (showbArgs) +# if !(MIN_VERSION_base(4,20,0)) +import TextShow.Data.Typeable.Utils (showbTuple) +#endif import Type.Reflection (pattern App, pattern Con, pattern Con', pattern Fun, SomeTypeRep(..), TypeRep, eqTypeRep, tyConName, typeRep, typeRepTyCon) #else /* !(MIN_VERSION_base(4,10,0) */ -import Data.Text.Lazy.Builder (fromString, singleton) +import Data.Text.Lazy.Builder (Builder, fromString, singleton) import Data.Typeable (TypeRep, typeRepArgs, typeRepTyCon) -import Data.Typeable.Internal (tyConName) -# if MIN_VERSION_base(4,8,0) -import Data.Typeable.Internal (typeRepKinds) -# endif -# if MIN_VERSION_base(4,9,0) -import Data.Text.Lazy.Builder (Builder) import Data.Typeable.Internal (Proxy(..), Typeable, - TypeRep(TypeRep), typeRep) -import GHC.Exts (RuntimeRep(..), TYPE) -# else -import Data.Typeable.Internal (funTc, listTc) -# endif + TypeRep(TypeRep), tyConName, typeRep, + typeRepKinds) -# if MIN_VERSION_base(4,9,0) -import GHC.Exts (Addr#, Char(..), (+#), eqChar#, indexCharOffAddr#) +import GHC.Exts (Addr#, Char(..), RuntimeRep(..), TYPE, + (+#), eqChar#, indexCharOffAddr#) import GHC.Types (TyCon(..), TrName(..), Module(..), isTrue#) -# else -import Data.Typeable.Internal (TyCon) -# endif import TextShow.Classes (TextShow(..), showbParen, showbSpace) import TextShow.Data.List () import TextShow.Data.Typeable.Utils (showbArgs, showbTuple) +#endif + +#if MIN_VERSION_base(4,13,0) +import Type.Reflection (typeRepKind) +#endif + +#if MIN_VERSION_base(4,19,0) +import Data.Char (isDigit, ord) +import Type.Reflection (tyConModule, tyConPackage) +#else import TextShow.Utils (isTupleString) #endif #if !(MIN_VERSION_base(4,10,0)) -# if MIN_VERSION_base(4,9,0) tyConOf :: Typeable a => Proxy a -> TyCon tyConOf = typeRepTyCon . typeRep @@ -92,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. @@ -131,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) @@ -168,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 <> " -> " @@ -193,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 @@ -240,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 diff --git a/src/TextShow/Data/Typeable/Utils.hs b/src/TextShow/Data/Typeable/Utils.hs --- a/src/TextShow/Data/Typeable/Utils.hs +++ b/src/TextShow/Data/Typeable/Utils.hs @@ -6,7 +6,7 @@ Stability: Provisional Portability: GHC -Utility functions for showing data types in the @Typeable@ (or @OldTypeable@) module. +Utility functions for showing data types in the @Typeable@ module. -} module TextShow.Data.Typeable.Utils (showbArgs, showbTuple) where diff --git a/src/TextShow/Data/Version.hs b/src/TextShow/Data/Version.hs --- a/src/TextShow/Data/Version.hs +++ b/src/TextShow/Data/Version.hs @@ -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 diff --git a/src/TextShow/Data/Void.hs b/src/TextShow/Data/Void.hs --- a/src/TextShow/Data/Void.hs +++ b/src/TextShow/Data/Void.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Data.Void Copyright: (C) 2014-2017 Ryan Scott @@ -13,7 +13,7 @@ -} module TextShow.Data.Void () where -import Data.Void.Compat (Void, absurd) +import Data.Void (Void, absurd) import Prelude () import TextShow.Classes (TextShow(..)) diff --git a/src/TextShow/Debug/Trace/Generic.hs b/src/TextShow/Debug/Trace/Generic.hs --- a/src/TextShow/Debug/Trace/Generic.hs +++ b/src/TextShow/Debug/Trace/Generic.hs @@ -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 diff --git a/src/TextShow/Foreign/C/Types.hs b/src/TextShow/Foreign/C/Types.hs --- a/src/TextShow/Foreign/C/Types.hs +++ b/src/TextShow/Foreign/C/Types.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Foreign.C.Types diff --git a/src/TextShow/Foreign/Ptr.hs b/src/TextShow/Foreign/Ptr.hs --- a/src/TextShow/Foreign/Ptr.hs +++ b/src/TextShow/Foreign/Ptr.hs @@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Foreign.Ptr Copyright: (C) 2014-2017 Ryan Scott @@ -16,7 +16,7 @@ -} module TextShow.Foreign.Ptr () where -import Data.Semigroup.Compat (mtimesDefault) +import Data.Semigroup (mtimesDefault) import Data.Text.Lazy.Builder (Builder, singleton) import Foreign.ForeignPtr (ForeignPtr) diff --git a/src/TextShow/FromStringTextShow.hs b/src/TextShow/FromStringTextShow.hs --- a/src/TextShow/FromStringTextShow.hs +++ b/src/TextShow/FromStringTextShow.hs @@ -1,9 +1,8 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveLift #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -12,13 +11,8 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -#if __GLASGOW_HASKELL__ >= 800 -{-# LANGUAGE DeriveLift #-} -#endif - -{-# OPTIONS_GHC -fno-warn-name-shadowing #-} +{-# OPTIONS_GHC -Wno-name-shadowing #-} {-| Module: TextShow.FromStringTextShow @@ -39,21 +33,16 @@ , FromTextShow2(..) ) where -#include "generic.h" - import Data.Bifunctor.TH (deriveBifunctor, deriveBifoldable, deriveBitraversable) import Data.Coerce (coerce) -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.Data (Data) +import Data.Functor.Classes (Show1(..), Show2(..), + showsPrec1, showsPrec2) import GHC.Generics (Generic, Generic1) -import Language.Haskell.TH.Lift +import Language.Haskell.TH.Syntax (Lift) import Prelude () import Prelude.Compat @@ -66,12 +55,6 @@ showbPrecToShowsPrec, showsPrecToShowbPrec, showbToShows, showsToShowb) -#if defined(NEW_FUNCTOR_CLASSES) -import Data.Functor.Classes (Show2(..), showsPrec1, showsPrec2) -#else -import Text.Show (showListWith) -#endif - ------------------------------------------------------------------------------- -- | An adapter newtype, suitable for @DerivingVia@. @@ -90,12 +73,9 @@ , Functor , Generic , Generic1 -#if __GLASGOW_HASKELL__ >= 800 , Lift -#endif , Ord , Traversable - , Typeable ) instance Read a => Read (FromStringShow a) where @@ -114,26 +94,6 @@ show = coerce (show :: a -> String) showList = coerce (showList :: [a] -> ShowS) -instance Show1 FromStringShow where -#if defined(NEW_FUNCTOR_CLASSES) - liftShowList _ sl = sl . coerceList - where - coerceList :: [FromStringShow a] -> [a] - coerceList = coerce - liftShowsPrec sp _ p = sp p . fromStringShow -#else - showsPrec1 p = showsPrec p . fromStringShow -#endif - -instance TextShow1 FromStringShow where - liftShowbPrec sp' _ p = - showsPrecToShowbPrec (showbPrecToShowsPrec sp') p . fromStringShow - - liftShowbList _ sl' = showsToShowb (showbToShows sl') . coerceList - where - coerceList :: [FromStringShow a] -> [a] - coerceList = coerce - ------------------------------------------------------------------------------- -- | An adapter newtype, suitable for @DerivingVia@. @@ -152,13 +112,10 @@ , Functor , Generic , Generic1 -#if __GLASGOW_HASKELL__ >= 800 , Lift -#endif , Ord , TextShow , Traversable - , Typeable ) instance Read a => Read (FromTextShow a) where @@ -172,27 +129,6 @@ show (FromTextShow x) = showbToShows showb x "" showList l = showbToShows showbList (coerce l :: [a]) -instance Show1 FromTextShow where -#if defined(NEW_FUNCTOR_CLASSES) - liftShowList _ sl = showbToShows (showsToShowb sl) . coerceList - where - coerceList :: [FromTextShow a] -> [a] - coerceList = coerce - liftShowsPrec sp _ p - = showbPrecToShowsPrec (showsPrecToShowbPrec sp) p . fromTextShow -#else - showsPrec1 p - = showbPrecToShowsPrec (showsPrecToShowbPrec showsPrec) p . fromTextShow -#endif - -instance TextShow1 FromTextShow where - liftShowbPrec sp' _ p = sp' p . fromTextShow - - liftShowbList _ sl' = sl' . coerceList - where - coerceList :: [FromTextShow a] -> [a] - coerceList = coerce - ------------------------------------------------------------------------------- -- | An adapter newtype, suitable for @DerivingVia@. @@ -209,48 +145,32 @@ -- /Since: 3/ newtype FromStringShow1 f a = FromStringShow1 { fromStringShow1 :: f a } deriving ( Eq - , Ord - , Generic -#if defined(__LANGUAGE_DERIVE_GENERIC1__) - , Generic1 -#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) -deriving instance Typeable FromStringShow1 -deriving instance ( Data (f a), Typeable f, Typeable a - ) => Data (FromStringShow1 f (a :: *)) -#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) @@ -263,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 @@ -285,48 +204,37 @@ -- /Since: 3/ newtype FromTextShow1 f a = FromTextShow1 { fromTextShow1 :: f a } deriving ( Eq - , Ord - , Generic -#if defined(__LANGUAGE_DERIVE_GENERIC1__) - , Generic1 -#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) -deriving instance Typeable FromTextShow1 -deriving instance ( Data (f a), Typeable f, Typeable a - ) => Data (FromTextShow1 f (a :: *)) -#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)) @@ -334,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 @@ -364,55 +269,42 @@ -- /Since: 3/ newtype FromStringShow2 f a b = FromStringShow2 { fromStringShow2 :: f a b } deriving ( Eq - , Ord - , Generic -#if defined(__LANGUAGE_DERIVE_GENERIC1__) - , Generic1 -#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) -deriving instance Typeable FromStringShow2 -deriving instance ( Data (f a b), Typeable f, Typeable a, Typeable b - ) => Data (FromStringShow2 f (a :: *) (b :: *)) -#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) @@ -430,16 +322,13 @@ coerceList :: [FromStringShow2 f a b] -> [f a b] coerceList = coerce --- | Not available if using @transformers-0.4@ instance (Show2 f, Show a, Show b) => Show (FromStringShow2 f a b) where showsPrec = showsPrec2 showList = liftShowList2 showsPrec showList showsPrec showList --- | Not available if using @transformers-0.4@ instance (Show2 f, Show a) => Show1 (FromStringShow2 f a) where liftShowsPrec = liftShowsPrec2 showsPrec showList liftShowList = liftShowList2 showsPrec showList -#endif ------------------------------------------------------------------------------- @@ -459,53 +348,50 @@ -- /Since: 3/ newtype FromTextShow2 f a b = FromTextShow2 { fromTextShow2 :: f a b } deriving ( Eq - , Ord - , Generic -#if defined(__LANGUAGE_DERIVE_GENERIC1__) - , Generic1 -#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) -deriving instance Typeable FromTextShow2 -deriving instance ( Data (f a b), Typeable f, Typeable a, Typeable b - ) => Data (FromTextShow2 f (a :: *) (b :: *)) -#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) @@ -522,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 @@ -534,53 +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 diff --git a/src/TextShow/Functions.hs b/src/TextShow/Functions.hs --- a/src/TextShow/Functions.hs +++ b/src/TextShow/Functions.hs @@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Functions Copyright: (C) 2014-2017 Ryan Scott diff --git a/src/TextShow/GHC/Conc/Windows.hs b/src/TextShow/GHC/Conc/Windows.hs --- a/src/TextShow/GHC/Conc/Windows.hs +++ b/src/TextShow/GHC/Conc/Windows.hs @@ -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) diff --git a/src/TextShow/GHC/Event.hs b/src/TextShow/GHC/Event.hs --- a/src/TextShow/GHC/Event.hs +++ b/src/TextShow/GHC/Event.hs @@ -1,9 +1,9 @@ {-# LANGUAGE CPP #-} -#if !defined(__GHCJS__) && !defined(mingw32_HOST_OS) +#if !defined(__GHCJS__) && !defined(ghcjs_HOST_OS) && !defined(mingw32_HOST_OS) {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} #endif {-| Module: TextShow.GHC.Event @@ -20,12 +20,12 @@ -} module TextShow.GHC.Event () where -#if !defined(__GHCJS__) && !defined(mingw32_HOST_OS) +#if !defined(__GHCJS__) && !defined(ghcjs_HOST_OS) && !defined(mingw32_HOST_OS) import Data.List (intersperse) import Data.Maybe (catMaybes) import Data.Text.Lazy.Builder (Builder, singleton) -import GHC.Event (Event, evtRead, evtWrite) +import GHC.Event (Event, Lifetime, evtRead, evtWrite) import Language.Haskell.TH.Lib (conT, varE) @@ -39,10 +39,6 @@ import TextShow.TH.Names (evtCloseValName, eventIsValName, fdKeyTypeName, uniqueTypeName, asInt64ValName) -# if MIN_VERSION_base(4,8,1) -import GHC.Event (Lifetime) -# endif - -- | /Since: 2/ instance TextShow Event where showb e = singleton '[' <> mconcat (intersperse "," $ catMaybes @@ -62,10 +58,6 @@ showb = showb . $(varE asInt64ValName) {-# INLINE showb #-} -# if MIN_VERSION_base(4,8,1) --- | Only available with @base-4.8.1.0@ or later. --- --- /Since: 2/ +-- | /Since: 2/ $(deriveTextShow ''Lifetime) -# endif #endif diff --git a/src/TextShow/GHC/Fingerprint.hs b/src/TextShow/GHC/Fingerprint.hs --- a/src/TextShow/GHC/Fingerprint.hs +++ b/src/TextShow/GHC/Fingerprint.hs @@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.GHC.Fingerprint Copyright: (C) 2014-2017 Ryan Scott @@ -14,7 +14,7 @@ -} module TextShow.GHC.Fingerprint () where -import Data.Semigroup.Compat (mtimesDefault) +import Data.Semigroup (mtimesDefault) import Data.Text.Lazy.Builder (Builder, singleton) import Data.Word (Word64) diff --git a/src/TextShow/GHC/Generics.hs b/src/TextShow/GHC/Generics.hs --- a/src/TextShow/GHC/Generics.hs +++ b/src/TextShow/GHC/Generics.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE KindSignatures #-} @@ -7,7 +6,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.GHC.Generics @@ -23,7 +22,7 @@ -} module TextShow.GHC.Generics () where -import Generics.Deriving.Base +import GHC.Generics import TextShow.Classes (TextShow(..), TextShow1(..), TextShow2(..)) import TextShow.Data.Char () @@ -118,22 +117,9 @@ $(deriveTextShow ''Associativity) -- | /Since: 2/ $(deriveTextShow ''Fixity) -#if MIN_VERSION_base(4,9,0) --- | Only available with @base-4.9.0.0@ or later. --- --- /Since: 3/ +-- | /Since: 3/ $(deriveTextShow ''SourceUnpackedness) --- | Only available with @base-4.9.0.0@ or later. --- --- /Since: 3/ +-- | /Since: 3/ $(deriveTextShow ''SourceStrictness) --- | Only available with @base-4.9.0.0@ or later. --- --- /Since: 3/ +-- | /Since: 3/ $(deriveTextShow ''DecidedStrictness) -#else --- | Only available with @base-4.8@ or earlier. --- --- /Since: 2/ -$(deriveTextShow ''Arity) -#endif diff --git a/src/TextShow/GHC/RTS/Flags.hs b/src/TextShow/GHC/RTS/Flags.hs --- a/src/TextShow/GHC/RTS/Flags.hs +++ b/src/TextShow/GHC/RTS/Flags.hs @@ -1,9 +1,6 @@ {-# LANGUAGE CPP #-} - -#if MIN_VERSION_base(4,8,0) {-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -#endif +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.GHC.RTS.Flags Copyright: (C) 2014-2017 Ryan Scott @@ -13,14 +10,17 @@ Portability: GHC 'TextShow' instances for data types in the 'GHC.RTS.Flags' module. -Only provided if using @base-4.8.0.0@ or later. /Since: 2/ -} module TextShow.GHC.RTS.Flags () where -#if MIN_VERSION_base(4,8,0) import GHC.RTS.Flags +#if MIN_VERSION_base(4,21,0) +import qualified GHC.IO.SubSystem as SubSystem +#elif MIN_VERSION_base(4,15,0) +import qualified GHC.RTS.Flags as SubSystem +#endif import TextShow.Data.Bool () import TextShow.Data.Char () @@ -45,10 +45,14 @@ $(deriveTextShow ''GCFlags) -- | /Since: 2/ $(deriveTextShow ''ConcFlags) -# if MIN_VERSION_base(4,15,0) +#if MIN_VERSION_base(4,15,0) -- | /Since: 3.9/ -$(deriveTextShow ''IoSubSystem) -# endif +$(deriveTextShow ''SubSystem.IoSubSystem) +#endif +#if MIN_VERSION_base(4,21,0) +-- | /Since: 3.11/ +$(deriveTextShow ''IoManagerFlag) +#endif -- | /Since: 2/ $(deriveTextShow ''MiscFlags) -- | /Since: 2/ @@ -61,12 +65,17 @@ $(deriveTextShow ''TraceFlags) -- | /Since: 2/ $(deriveTextShow ''TickyFlags) -# if MIN_VERSION_base(4,10,0) +#if MIN_VERSION_base(4,10,0) -- | Only available with @base-4.10.0.0@ or later. -- -- /Since: 3.3/ $(deriveTextShow ''ParFlags) -# endif +#endif +#if MIN_VERSION_base(4,20,0) +-- | Only available with @base-4.20.0.0@ or later. +-- +-- /Since: 3.10.5/ +$(deriveTextShow ''HpcFlags) +#endif -- | /Since: 2/ $(deriveTextShow ''RTSFlags) -#endif diff --git a/src/TextShow/GHC/Stack.hs b/src/TextShow/GHC/Stack.hs --- a/src/TextShow/GHC/Stack.hs +++ b/src/TextShow/GHC/Stack.hs @@ -1,9 +1,6 @@ {-# LANGUAGE CPP #-} - -#if MIN_VERSION_base(4,8,1) {-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -#endif +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.GHC.Stack Copyright: (C) 2014-2017 Ryan Scott @@ -13,21 +10,14 @@ Portability: GHC 'TextShow' instances for 'CallStack' and 'SrcLoc' values. -Only provided if using @base-4.8.1.0@ or later. /Since: 3.0.1/ -} module TextShow.GHC.Stack () where -#if MIN_VERSION_base(4,8,1) -import GHC.Stack (CallStack) -# if MIN_VERSION_base(4,9,0) -import GHC.Stack (SrcLoc, getCallStack) -import TextShow.Classes (TextShow(..)) -# else -import GHC.SrcLoc (SrcLoc) -# endif +import GHC.Stack (CallStack, SrcLoc, getCallStack) +import TextShow.Classes (TextShow(..)) import TextShow.Data.Char () import TextShow.Data.Integral () import TextShow.Data.List () @@ -37,13 +27,7 @@ -- | /Since: 3.0.1/ $(deriveTextShow ''SrcLoc) -# if MIN_VERSION_base(4,9,0) -- | /Since: 3.0.1/ instance TextShow CallStack where showb = showb . getCallStack {-# INLINE showb #-} -# else --- | /Since: 3.0.1/ -$(deriveTextShow ''CallStack) -# endif -#endif diff --git a/src/TextShow/GHC/StaticPtr.hs b/src/TextShow/GHC/StaticPtr.hs --- a/src/TextShow/GHC/StaticPtr.hs +++ b/src/TextShow/GHC/StaticPtr.hs @@ -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 diff --git a/src/TextShow/GHC/Stats.hs b/src/TextShow/GHC/Stats.hs --- a/src/TextShow/GHC/Stats.hs +++ b/src/TextShow/GHC/Stats.hs @@ -2,8 +2,8 @@ #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 #-} diff --git a/src/TextShow/GHC/TypeLits.hs b/src/TextShow/GHC/TypeLits.hs --- a/src/TextShow/GHC/TypeLits.hs +++ b/src/TextShow/GHC/TypeLits.hs @@ -1,4 +1,5 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.GHC.TypeLits Copyright: (C) 2014-2017 Ryan Scott @@ -14,6 +15,9 @@ module TextShow.GHC.TypeLits () where 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 @@ -22,6 +26,15 @@ import TextShow.Data.Char () import TextShow.Data.Integral () +#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 + -- | /Since: 2/ instance TextShow SomeNat where showbPrec p (SomeNat x) = showbPrec p $ natVal x @@ -31,3 +44,36 @@ instance TextShow SomeSymbol where showb (SomeSymbol x) = showbList $ symbolVal x {-# INLINE showb #-} + +#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 + +#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 diff --git a/src/TextShow/Generic.hs b/src/TextShow/Generic.hs --- a/src/TextShow/Generic.hs +++ b/src/TextShow/Generic.hs @@ -5,6 +5,7 @@ {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveLift #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE EmptyCase #-} {-# LANGUAGE EmptyDataDecls #-} @@ -23,8 +24,8 @@ {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-} -#if __GLASGOW_HASKELL__ >= 800 -{-# LANGUAGE DeriveLift #-} +#if __GLASGOW_HASKELL__ >= 806 +{-# LANGUAGE QuantifiedConstraints #-} #endif {-| @@ -51,9 +52,6 @@ -- * Generic @show@ functions -- $generics - - -- ** Understanding a compiler error - -- $generic_err , genericShowt , genericShowtl , genericShowtPrec @@ -73,24 +71,24 @@ -- ** 'Builder' , GTextShowB(..) , GTextShowConB(..) - , ShowFunsB(..) + , GTextShowB1(..) + , GTextShowConB1(..) -- ** Strict 'TS.Text' , GTextShowT(..) , GTextShowConT(..) - , ShowFunsT(..) + , GTextShowT1(..) + , GTextShowConT1(..) -- ** Lazy 'TL.Text' , GTextShowTL(..) , GTextShowConTL(..) - , ShowFunsTL(..) + , GTextShowTL1(..) + , GTextShowConTL1(..) -- ** Other internals , IsNullary(..) , ConType(..) - , Zero - , One ) where import Data.Data (Data, Typeable) -import Data.Functor.Contravariant.Compat (Contravariant(..)) import qualified Data.Text as TS (Text, pack, singleton) import qualified Data.Text.IO as TS (putStrLn, hPutStrLn) import qualified Data.Text.Lazy as TL (Text, pack, singleton) @@ -98,15 +96,12 @@ import qualified Data.Text.Lazy.Builder as TB (fromString, singleton) import Data.Text.Lazy.Builder (Builder) -import Generics.Deriving.Base -#if !defined(__LANGUAGE_DERIVE_GENERIC1__) -import qualified Generics.Deriving.TH as Generics -#endif +import GHC.Generics import GHC.Exts (Char(C#), Double(D#), Float(F#), Int(I#), Word(W#)) import GHC.Show (appPrec, appPrec1) -import Language.Haskell.TH.Lift +import Language.Haskell.TH.Syntax (Lift) import Prelude () import Prelude.Compat @@ -152,30 +147,6 @@ @ -} -{- $generic_err - -Suppose you intend to define a 'TextShow' instance via 'FromGeneric': - -@ -data Oops = Oops - deriving 'TextShow' via 'FromGeneric' Oops - -- forgot to add \"deriving Generic\" here! -@ - -If you forget to add a @deriving 'Generic'@ clause to your data type, at -compile-time, you might get an error message that begins roughly as follows: - -@ -No instance for ('GTextShowB' 'Zero' ('Rep' Oops)) -@ - -This error can be confusing, but don't let it intimidate you. The correct fix is -simply to add the missing \"@deriving 'Generic'@\" clause. - -Similarly, if the compiler complains about not having an instance for @('GTextShowB' -'One' ('Rep1' Oops1))@, add a \"@deriving 'Generic1'@\" clause. --} - -- | An adapter newtype, suitable for @DerivingVia@. -- The 'TextShow' instance for 'FromGeneric' leverages a 'Generic'-based -- default. That is, @@ -196,14 +167,11 @@ , Read , Show , Traversable - , Typeable -#if __GLASGOW_HASKELL__ >= 800 , Lift -#endif ) -- | /Since: 3.7.4/ -instance (Generic a, GTextShowB Zero (Rep a)) => TextShow (FromGeneric a) where +instance (Generic a, GTextShowB (Rep a ())) => TextShow (FromGeneric a) where showbPrec p = genericShowbPrec p . fromGeneric -- | An adapter newtype, suitable for @DerivingVia@. @@ -221,121 +189,136 @@ , Read , Show , Generic -#if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 -#endif -#if __GLASGOW_HASKELL__ >= 800 , Lift -#endif ) deriving instance Foldable f => Foldable (FromGeneric1 f) deriving instance Functor f => Functor (FromGeneric1 f) deriving instance Traversable f => Traversable (FromGeneric1 f) -deriving instance Typeable FromGeneric1 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, GTextShowB One (Rep1 f)) => TextShow1 (FromGeneric1 f) where +instance ( Generic1 f +#if __GLASGOW_HASKELL__ >= 806 && __GLASGOW_HASKELL__ < 902 + -- Unfortunately, the quantified superclass for GTextShowB1 doesn't + -- work on pre-9.2 versions of GHC when using a GTextShowB1 (Rep1 f) + -- constraint directly, perhaps due to + -- https://gitlab.haskell.org/ghc/ghc/-/issues/14860#note_454218. + -- Fortunately, we can make GHC come to its senses by using an + -- equality constraint. + , g ~ Rep1 f, GTextShowB1 g +#else + , GTextShowB1 (Rep1 f) +#endif + ) => TextShow1 (FromGeneric1 f) where liftShowbPrec sp sl p = genericLiftShowbPrec sp sl p . fromGeneric1 -- | A 'Generic' implementation of 'showt'. -- -- /Since: 2/ -genericShowt :: (Generic a, GTextShowT Zero (Rep a)) => a -> TS.Text +genericShowt :: (Generic a, GTextShowT (Rep a ())) => a -> TS.Text genericShowt = genericShowtPrec 0 -- | A 'Generic' implementation of 'showtl'. -- -- /Since: 2/ -genericShowtl :: (Generic a, GTextShowTL Zero (Rep a)) => a -> TL.Text +genericShowtl :: (Generic a, GTextShowTL (Rep a ())) => a -> TL.Text genericShowtl = genericShowtlPrec 0 -- | A 'Generic' implementation of 'showPrect'. -- -- /Since: 2/ -genericShowtPrec :: (Generic a, GTextShowT Zero (Rep a)) => Int -> a -> TS.Text -genericShowtPrec p = gShowtPrec NoShowFunsT p . from +genericShowtPrec :: (Generic a, GTextShowT (Rep a ())) => Int -> a -> TS.Text +genericShowtPrec p = gShowtPrec p . fromRepUnit -- | A 'Generic' implementation of 'showtlPrec'. -- -- /Since: 2/ -genericShowtlPrec :: (Generic a, GTextShowTL Zero (Rep a)) => Int -> a -> TL.Text -genericShowtlPrec p = gShowtlPrec NoShowFunsTL p . from +genericShowtlPrec :: (Generic a, GTextShowTL (Rep a ())) => Int -> a -> TL.Text +genericShowtlPrec p = gShowtlPrec p . fromRepUnit -- | A 'Generic' implementation of 'showtList'. -- -- /Since: 2/ -genericShowtList :: (Generic a, GTextShowT Zero (Rep a)) => [a] -> TS.Text +genericShowtList :: (Generic a, GTextShowT (Rep a ())) => [a] -> TS.Text genericShowtList = showtListWith genericShowt -- | A 'Generic' implementation of 'showtlList'. -- -- /Since: 2/ -genericShowtlList :: (Generic a, GTextShowTL Zero (Rep a)) => [a] -> TL.Text +genericShowtlList :: (Generic a, GTextShowTL (Rep a ())) => [a] -> TL.Text genericShowtlList = showtlListWith genericShowtl -- | A 'Generic' implementation of 'showb'. -- -- /Since: 2/ -genericShowb :: (Generic a, GTextShowB Zero (Rep a)) => a -> Builder +genericShowb :: (Generic a, GTextShowB (Rep a ())) => a -> Builder genericShowb = genericShowbPrec 0 -- | A 'Generic' implementation of 'showbPrec'. -- -- /Since: 2/ -genericShowbPrec :: (Generic a, GTextShowB Zero (Rep a)) => Int -> a -> Builder -genericShowbPrec p = gShowbPrec NoShowFunsB p . from +genericShowbPrec :: (Generic a, GTextShowB (Rep a ())) => Int -> a -> Builder +genericShowbPrec p = gShowbPrec p . fromRepUnit -- | A 'Generic' implementation of 'showbList'. -- -- /Since: 2/ -genericShowbList :: (Generic a, GTextShowB Zero (Rep a)) => [a] -> Builder +genericShowbList :: (Generic a, GTextShowB (Rep a ())) => [a] -> Builder genericShowbList = showbListWith genericShowb -- | A 'Generic' implementation of 'printT'. -- -- /Since: 2/ -genericPrintT :: (Generic a, GTextShowT Zero (Rep a)) => a -> IO () +genericPrintT :: (Generic a, GTextShowT (Rep a ())) => a -> IO () genericPrintT = TS.putStrLn . genericShowt -- | A 'Generic' implementation of 'printTL'. -- -- /Since: 2/ -genericPrintTL :: (Generic a, GTextShowTL Zero (Rep a)) => a -> IO () +genericPrintTL :: (Generic a, GTextShowTL (Rep a ())) => a -> IO () genericPrintTL = TL.putStrLn . genericShowtl -- | A 'Generic' implementation of 'hPrintT'. -- -- /Since: 2/ -genericHPrintT :: (Generic a, GTextShowT Zero (Rep a)) => Handle -> a -> IO () +genericHPrintT :: (Generic a, GTextShowT (Rep a ())) => Handle -> a -> IO () genericHPrintT h = TS.hPutStrLn h . genericShowt -- | A 'Generic' implementation of 'hPrintTL'. -- -- /Since: 2/ -genericHPrintTL :: (Generic a, GTextShowTL Zero (Rep a)) => Handle -> a -> IO () +genericHPrintTL :: (Generic a, GTextShowTL (Rep a ())) => Handle -> a -> IO () genericHPrintTL h = TL.hPutStrLn h . genericShowtl -- | A 'Generic1' implementation of 'genericLiftShowbPrec'. -- -- /Since: 2/ -genericLiftShowbPrec :: (Generic1 f, GTextShowB One (Rep1 f)) +genericLiftShowbPrec :: (Generic1 f, GTextShowB1 (Rep1 f)) => (Int -> a -> Builder) -> ([a] -> Builder) -> Int -> f a -> Builder -genericLiftShowbPrec sp sl p = gShowbPrec (Show1FunsB sp sl) p . from1 +genericLiftShowbPrec sp sl p = gLiftShowbPrec sp sl p . from1 -- | A 'Generic'/'Generic1' implementation of 'showbPrec1'. -- -- /Since: 2/ genericShowbPrec1 :: ( Generic a, Generic1 f - , GTextShowB Zero (Rep a) - , GTextShowB One (Rep1 f) + , GTextShowB (Rep a ()) + , GTextShowB1 (Rep1 f) ) => Int -> f a -> Builder genericShowbPrec1 = genericLiftShowbPrec genericShowbPrec genericShowbList +-- | A type-specialized version of 'from' used to assist type inference. +fromRepUnit :: Generic a => a -> Rep a () +fromRepUnit = from + ------------------------------------------------------------------------------- -- | Whether a constructor is a record ('Rec'), a tuple ('Tup'), is prefix ('Pref'), @@ -349,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 @@ -381,217 +351,335 @@ See #33. -} -#if __GLASGOW_HASKELL__ >= 711 -#define HASH_FUNS(text_type,one_hash,two_hash,hash_prec,from_char,from_string) \ +hashPrec :: Int -> Int +hashPrec = const 0 + +#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 \ +}; \ \ -deriving instance Typeable gtext_show; \ +instance gtext_show_con (U1 p) where { \ + ; gshow_prec_con _ _ U1 = mempty \ +}; \ \ -instance gtext_show arity f => gtext_show arity (D1 d f) where { \ - gshow_prec sfs p (M1 x) = gshow_prec sfs p x \ - }; \ +instance TextShow p => gtext_show_con (Par1 p) where { \ + ; gshow_prec_con _ p (Par1 x) = show_prec p x \ +}; \ \ -instance gtext_show arity V1 where { \ - gshow_prec _ _ x = case x of {} \ - }; \ +instance TextShow c => gtext_show_con (K1 i c p) where { \ + ; gshow_prec_con _ p (K1 x) = show_prec p x \ +}; \ \ -instance (gtext_show arity f, gtext_show arity g) => gtext_show arity (f :+: g) where { \ - gshow_prec sfs p (L1 x) = gshow_prec sfs p x \ - ; gshow_prec sfs p (R1 x) = gshow_prec sfs p x \ - }; \ +instance (TextShow1 f, TextShow p) => gtext_show_con (Rec1 f p) where { \ + ; gshow_prec_con _ p (Rec1 x) = lift_show_prec show_prec show_list p x \ +}; \ \ -instance (Constructor c, gtext_show_con arity f, IsNullary f) \ - => gtext_show arity (C1 c f) where { \ - gshow_prec sfs p c@(M1 x) = case fixity of { \ - Prefix -> show_paren ( p > appPrec \ - && not (isNullary x || conIsTuple c) \ - ) $ \ - (if conIsTuple c \ - then mempty \ - else let cn = conName c \ - in show_paren (isInfixDataCon cn) $ from_string cn) \ - <> (if isNullary x || conIsTuple c \ - then mempty \ - else from_char ' ') \ - <> showbBraces t (gshow_prec_con t sfs appPrec1 x) \ - ; Infix _ m -> show_paren (p > m) $ gshow_prec_con t sfs (m+1) x \ - } \ - where { \ - fixity :: Fixity \ - ; fixity = conFixity c \ +instance (Selector s, gtext_show_con (f p)) => gtext_show_con (S1 s f p) where { \ + ; gshow_prec_con t = s1_show_prec $ gshow_prec_con t \ +}; \ \ - ; t :: ConType \ - ; t = if conIsRecord c \ - then Rec \ - else case conIsTuple c of { \ - True -> Tup \ - ; False -> case fixity of { \ - Prefix -> Pref \ - ; Infix _ _ -> Inf $ conName c \ - }; \ - } \ +instance (gtext_show_con (f p), gtext_show_con (g p)) \ + => gtext_show_con ((f :*: g) p) where { \ + ; gshow_prec_con t = product_show_prec (gshow_prec_con t) (gshow_prec_con t) t \ +}; \ \ - ; showbBraces :: ConType -> text_type -> text_type \ - ; showbBraces Rec b = from_char '{' <> b <> from_char '}' \ - ; showbBraces Tup b = from_char '(' <> b <> from_char ')' \ - ; showbBraces Pref b = b \ - ; showbBraces (Inf _) b = b \ +instance (TextShow1 f, gtext_show_con (g p)) => gtext_show_con ((f :.: g) p) where { \ + ; gshow_prec_con t p (Comp1 x) = \ + let gspc = gshow_prec_con t \ + in lift_show_prec gspc (show_list_with (gspc 0)) p x \ +}; \ \ - ; conIsTuple :: C1 c f p -> Bool \ - ; conIsTuple = isTupleString . conName \ - }; \ - }; \ +instance gtext_show_con (UChar p) where { \ + ; gshow_prec_con _ = u_char_show_prec show_prec \ +}; \ \ -{- | Class of generic representation types for which the 'ConType' has been \ -determined. The @arity@ type variable indicates which type class is \ -used. @'gtext_show_con' 'Zero'@ indicates 'TextShow' behavior, and \ -@'gtext_show_con' 'One'@ indicates 'TextShow1' behavior. \ +instance gtext_show_con (UDouble p) where { \ + ; gshow_prec_con _ = u_double_show_prec show_prec \ +}; \ + \ +instance gtext_show_con (UFloat p) where { \ + ; gshow_prec_con _ = u_float_show_prec show_prec \ +}; \ + \ +instance gtext_show_con (UInt p) where { \ + ; gshow_prec_con _ = u_int_show_prec show_prec \ +}; \ + \ +instance gtext_show_con (UWord p) where { \ + ; gshow_prec_con _ = u_word_show_prec show_prec \ +}; \ + \ +{- | Class of generic representation types for unary type constructors that can \ +be converted to a 'text_type'. \ + \ +/Since: 3.10/ \ -}; \ -class gtext_show_con arity f where { \ - {- | Convert value of a specific 'ConType' to a 'text_type' with the given \ - precedence. \ - -} \ - ; gshow_prec_con :: ConType -> show_funs arity a -> Int -> f a -> text_type \ - }; \ +class QUANTIFIED_SUPERCLASS(gtext_show,f) \ + gtext_show1 f where { \ + ; glift_show_prec :: (Int -> a -> text_type) -> ([a] -> text_type) \ + -> Int -> f a -> text_type \ +}; \ \ -deriving instance 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. @@ -638,16 +726,3 @@ ------------------------------------------------------------------------------- $(deriveTextShow ''ConType) - -#if __GLASGOW_HASKELL__ < 800 -$(deriveLift ''ConType) -$(deriveLift ''FromGeneric) - -instance Lift (f a) => Lift (FromGeneric1 f a) where - lift = $(makeLift ''FromGeneric1) -#endif - -#if !defined(__LANGUAGE_DERIVE_GENERIC1__) -$(Generics.deriveMeta ''FromGeneric1) -$(Generics.deriveRepresentable1 ''FromGeneric1) -#endif diff --git a/src/TextShow/Instances.hs b/src/TextShow/Instances.hs --- a/src/TextShow/Instances.hs +++ b/src/TextShow/Instances.hs @@ -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 () diff --git a/src/TextShow/Numeric/Natural.hs b/src/TextShow/Numeric/Natural.hs --- a/src/TextShow/Numeric/Natural.hs +++ b/src/TextShow/Numeric/Natural.hs @@ -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 @@ -21,12 +19,12 @@ import GHC.Exts (Word(..)) import GHC.Num (integerFromNatural) import GHC.Num.Natural (Natural(..)) -#elif MIN_VERSION_base(4,8,0) && defined(MIN_VERSION_integer_gmp) +#elif defined(MIN_VERSION_integer_gmp) import GHC.Exts (Word(..)) import GHC.Integer.GMP.Internals (Integer(..)) import GHC.Natural (Natural(..)) #else -import Numeric.Natural.Compat (Natural) +import Numeric.Natural (Natural) #endif import TextShow.Classes (TextShow(..)) @@ -37,7 +35,7 @@ #if MIN_VERSION_base(4,15,0) showbPrec p (NS w) = showbPrec p (W# w) showbPrec p n = showbPrec p (integerFromNatural n) -#elif MIN_VERSION_base(4,8,0) && defined(MIN_VERSION_integer_gmp) +#elif defined(MIN_VERSION_integer_gmp) showbPrec _ (NatS# w#) = showb $ W# w# showbPrec p (NatJ# bn) = showbPrec p $ Jp# bn #else diff --git a/src/TextShow/Options.hs b/src/TextShow/Options.hs --- a/src/TextShow/Options.hs +++ b/src/TextShow/Options.hs @@ -1,12 +1,6 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} - -#if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE DeriveLift #-} -#endif {-| Module: TextShow.Options @@ -22,12 +16,12 @@ -} module TextShow.Options (Options(..), GenTextMethods(..), defaultOptions) where -import Data.Data (Data, Typeable) +import Data.Data (Data) import Data.Ix (Ix) import GHC.Generics (Generic) -import Language.Haskell.TH.Lift +import Language.Haskell.TH.Syntax (Lift) -- | Options that specify how to derive 'TextShow' instances using Template Haskell. -- @@ -50,10 +44,7 @@ , Ord , Read , Show - , Typeable -#if __GLASGOW_HASKELL__ >= 800 , Lift -#endif ) -- | When should Template Haskell generate implementations for the methods of @@ -73,10 +64,7 @@ , Ord , Read , Show - , Typeable -#if __GLASGOW_HASKELL__ >= 800 , Lift -#endif ) -- | Sensible default 'Options'. @@ -87,10 +75,3 @@ Options { genTextMethods = SometimesTextMethods , emptyCaseBehavior = False } - -------------------------------------------------------------------------------- - -#if __GLASGOW_HASKELL__ < 800 -$(deriveLift ''Options) -$(deriveLift ''GenTextMethods) -#endif diff --git a/src/TextShow/System/Exit.hs b/src/TextShow/System/Exit.hs --- a/src/TextShow/System/Exit.hs +++ b/src/TextShow/System/Exit.hs @@ -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 diff --git a/src/TextShow/System/IO.hs b/src/TextShow/System/IO.hs --- a/src/TextShow/System/IO.hs +++ b/src/TextShow/System/IO.hs @@ -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 diff --git a/src/TextShow/System/Posix/Types.hs b/src/TextShow/System/Posix/Types.hs --- a/src/TextShow/System/Posix/Types.hs +++ b/src/TextShow/System/Posix/Types.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.System.Posix.Types diff --git a/src/TextShow/TH.hs b/src/TextShow/TH.hs --- a/src/TextShow/TH.hs +++ b/src/TextShow/TH.hs @@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.TH diff --git a/src/TextShow/TH/Internal.hs b/src/TextShow/TH/Internal.hs --- a/src/TextShow/TH/Internal.hs +++ b/src/TextShow/TH/Internal.hs @@ -1,8 +1,8 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE TemplateHaskell #-} {-| Module: TextShow.TH.Internal Copyright: (C) 2014-2017 Ryan Scott @@ -58,9 +58,9 @@ import Control.Monad (unless, when) import qualified Control.Monad as Monad (fail) -import Data.Foldable.Compat -import qualified Data.List.Compat as List -import Data.List.NonEmpty.Compat (NonEmpty(..), (<|)) +import Data.Foldable +import qualified Data.List as List +import Data.List.NonEmpty (NonEmpty(..), (<|)) import qualified Data.Map as Map (fromList, keys, lookup, singleton) import Data.Map (Map) import Data.Maybe @@ -80,10 +80,14 @@ , 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# @@ -91,8 +95,12 @@ #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 @@ -710,19 +718,11 @@ Nothing -> showPrecE `appE` integerE p `appE` tyVarE showPrimE :: PrimShow -> Q Exp - showPrimE PrimShow{ primShowBoxer -#if __GLASGOW_HASKELL__ >= 800 - , primShowPostfixMod, primShowConv -#endif - } -#if __GLASGOW_HASKELL__ >= 800 + showPrimE PrimShow{ primShowBoxer, primShowPostfixMod, primShowConv } -- Starting with GHC 8.0, data types containing unlifted types with -- derived Show instances show hashed literals with actual hash signs, -- and negative hashed literals are not surrounded with parentheses. = primShowConv tsFun $ infixApp (primE 0) [| (<>) |] (primShowPostfixMod tsFun) -#else - = primE p -#endif where primE :: Int -> Q Exp primE prec = showPrecE `appE` integerE prec `appE` primShowBoxer tyVarE @@ -874,14 +874,15 @@ map (substNamesWithKindStar (List.union droppedKindVarNames kvNames')) $ take remainingLength varTysOrig - isDataFamily :: Bool - isDataFamily = case variant of - Datatype -> False - Newtype -> False - DataInstance -> True - NewtypeInstance -> True + isDataFamily <- + case variant of + Datatype -> return False + Newtype -> return False + DataInstance -> return True + NewtypeInstance -> return True + Datatype.TypeData -> typeDataError tyConName - remainingTysOrigSubst' :: [Type] + let remainingTysOrigSubst' :: [Type] -- See Note [Kind signatures in derived instances] for an explanation -- of the isDataFamily check. remainingTysOrigSubst' = @@ -898,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. @@ -1062,6 +1063,15 @@ 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 ------------------------------------------------------------------------------- @@ -1249,8 +1259,50 @@ , primShowPostfixMod = twoHashE , primShowConv = \_ x -> x }) -#if MIN_VERSION_base(4,13,0) +#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 @@ -1270,8 +1322,8 @@ , primShowPostfixMod = twoHashE , primShowConv = mkNarrowE wordToWord16HashValName }) -#endif -#if MIN_VERSION_base(4,16,0) +# endif +# if MIN_VERSION_base(4,16,0) , (''Int32#, PrimShow { primShowBoxer = appE (conE 'I#) . appE (varE 'int32ToInt#) , primShowPostfixMod = oneHashE @@ -1282,10 +1334,11 @@ , primShowPostfixMod = twoHashE , primShowConv = mkNarrowE 'wordToWord32# }) +# endif #endif ] -#if MIN_VERSION_base(4,13,0) +#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` [| (<>) |]) @@ -1363,6 +1416,11 @@ 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 ------------------------------------------------------------------------------- @@ -1423,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: @@ -1488,22 +1542,10 @@ go tcName = do info <- reify tcName case info of -#if MIN_VERSION_template_haskell(2,11,0) FamilyI (OpenTypeFamilyD (TypeFamilyHead _ bndrs _ _)) _ -> withinFirstArgs bndrs -#else - FamilyI (FamilyD TypeFam _ bndrs _) _ - -> withinFirstArgs bndrs -#endif - -#if MIN_VERSION_template_haskell(2,11,0) FamilyI (ClosedTypeFamilyD (TypeFamilyHead _ bndrs _ _) _) _ -> withinFirstArgs bndrs -#else - FamilyI (ClosedTypeFamilyD _ bndrs _ _) _ - -> withinFirstArgs bndrs -#endif - _ -> return False where withinFirstArgs :: [a] -> Q Bool @@ -1534,15 +1576,6 @@ 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 @@ -1568,10 +1601,8 @@ go :: Type -> Type -> [Type] -> NonEmpty Type go _ (AppT ty1 ty2) args = go ty1 ty1 (ty2:args) go origTy (SigT ty' _) args = go origTy ty' args -#if MIN_VERSION_template_haskell(2,11,0) go origTy (InfixT ty1 n ty2) args = go origTy (ConT n `AppT` ty1 `AppT` ty2) args go origTy (ParensT ty') args = go origTy ty' args -#endif go origTy _ args = origTy :| args -- | Split a type signature by the arrows on its spine. For example, this: diff --git a/src/TextShow/Text/Read.hs b/src/TextShow/Text/Read.hs --- a/src/TextShow/Text/Read.hs +++ b/src/TextShow/Text/Read.hs @@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: TextShow.Text.Read Copyright: (C) 2014-2017 Ryan Scott diff --git a/tests/Derived/DataFamilies.hs b/tests/Derived/DataFamilies.hs --- a/tests/Derived/DataFamilies.hs +++ b/tests/Derived/DataFamilies.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} @@ -9,12 +8,6 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -#if __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 @@ -32,16 +25,7 @@ , NullaryData(..) ) where -#include "generic.h" - -#if !defined(__LANGUAGE_DERIVE_GENERIC1__) -import qualified Generics.Deriving.TH as Generics -#endif - -import GHC.Generics (Generic) -#if defined(__LANGUAGE_DERIVE_GENERIC1__) -import GHC.Generics (Generic1) -#endif +import GHC.Generics (Generic, Generic1) import Instances.Utils.GenericArbitrary (genericArbitrary) @@ -50,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) @@ -66,30 +47,19 @@ | NASShow2 d deriving ( Show , Generic -#if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 -#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 - ------------------------------------------------------------------------------- data family KindDistinguished (x :: k) (y :: *) (z :: *) :: * @@ -97,17 +67,13 @@ 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) @@ -118,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) @@ -137,11 +97,6 @@ $(deriveTextShow 'KindDistinguishedBool) $(deriveTextShow1 'KindDistinguishedBool) $(deriveTextShow2 'KindDistinguishedBool) - -#if !defined(__LANGUAGE_DERIVE_GENERIC1__) -$(Generics.deriveAll1 'KindDistinguishedUnit) -$(Generics.deriveAll1 'KindDistinguishedBool) -#endif ------------------------------------------------------------------------------- diff --git a/tests/Derived/DatatypeContexts.hs b/tests/Derived/DatatypeContexts.hs --- a/tests/Derived/DatatypeContexts.hs +++ b/tests/Derived/DatatypeContexts.hs @@ -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) diff --git a/tests/Derived/ExistentialQuantification.hs b/tests/Derived/ExistentialQuantification.hs --- a/tests/Derived/ExistentialQuantification.hs +++ b/tests/Derived/ExistentialQuantification.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE StandaloneDeriving #-} @@ -23,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) @@ -102,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) diff --git a/tests/Derived/Infix.hs b/tests/Derived/Infix.hs --- a/tests/Derived/Infix.hs +++ b/tests/Derived/Infix.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} @@ -23,12 +21,6 @@ , TyFamilyGADT(..) ) where -#include "generic.h" - -#if !defined(__LANGUAGE_DERIVE_GENERIC1__) -import qualified Generics.Deriving.TH as Generics -#endif - import GHC.Generics (Generic, Generic1) import Instances.Utils.GenericArbitrary (genericArbitrary) @@ -38,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) @@ -87,9 +76,7 @@ | TyFamilyFakeInfix a b deriving ( Show , Generic -#if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 -#endif ) ------------------------------------------------------------------------------- @@ -104,9 +91,7 @@ (:****) :: { tfg1 :: i, tfg2 :: j } -> TyFamilyGADT i j deriving ( Show , Generic -#if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 -#endif ) ------------------------------------------------------------------------------- @@ -126,11 +111,10 @@ ------------------------------------------------------------------------------- $(deriveShow1 ''TyConPlain) -$(deriveShow1 ''TyConGADT) -#if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2 ''TyConPlain) + +$(deriveShow1 ''TyConGADT) $(deriveShow2 ''TyConGADT) -#endif $(deriveTextShow ''TyConPlain) $(deriveTextShow1 ''TyConPlain) @@ -140,17 +124,11 @@ $(deriveTextShow1 ''TyConGADT) $(deriveTextShow2 ''TyConGADT) -#if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 '(:#:)) - -$(deriveShow1 '(:*)) -#else -$(deriveShow1 '(:#:)) $(deriveShow2 '(:$:)) $(deriveShow1 '(:*)) $(deriveShow2 '(:***)) -#endif $(deriveTextShow '(:#:)) $(deriveTextShow1 '(:$:)) @@ -159,10 +137,3 @@ $(deriveTextShow '(:*)) $(deriveTextShow1 '(:***)) $(deriveTextShow2 '(:****)) - -#if !defined(__LANGUAGE_DERIVE_GENERIC1__) -$(Generics.deriveMeta '(:#:)) -$(Generics.deriveRepresentable1 '(:$:)) -$(Generics.deriveMeta '(:*)) -$(Generics.deriveRepresentable1 '(:**)) -#endif diff --git a/tests/Derived/MagicHash.hs b/tests/Derived/MagicHash.hs --- a/tests/Derived/MagicHash.hs +++ b/tests/Derived/MagicHash.hs @@ -22,14 +22,8 @@ #endif ) where -#if __GLASGOW_HASKELL__ < 711 -import qualified Generics.Deriving.TH as Generics -#endif - import GHC.Exts -#if __GLASGOW_HASKELL__ >= 711 import GHC.Generics (Generic, Generic1) -#endif import Instances.Utils.GenericArbitrary (genericArbitrary) @@ -38,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) ------------------------------------------------------------------------------- @@ -55,10 +47,8 @@ , tcChar# :: Char# , tcWord# :: Word# } deriving ( Show -#if __GLASGOW_HASKELL__ >= 711 , Generic , Generic1 -#endif ) #if MIN_VERSION_base(4,13,0) @@ -89,10 +79,8 @@ , tfChar# :: Char# , tfWord# :: Word# } deriving ( Show -#if __GLASGOW_HASKELL__ >= 711 , Generic , Generic1 -#endif ) #if MIN_VERSION_base(4,13,0) @@ -187,32 +175,17 @@ ------------------------------------------------------------------------------- $(deriveShow1Options legacyShowOptions ''TyCon#) -#if defined(NEW_FUNCTOR_CLASSES) -$(deriveShow2Options legacyShowOptions ''TyCon#) -#endif $(deriveTextShow ''TyCon#) $(deriveTextShow1 ''TyCon#) $(deriveTextShow2 ''TyCon#) -#if __GLASGOW_HASKELL__ < 711 -$(Generics.deriveAll0And1 ''TyCon#) -#endif - -#if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1Options legacyShowOptions 'TyFamily#) -#else -$(deriveShow1Options legacyShowOptions 'TyFamily#) $(deriveShow2Options legacyShowOptions 'TyFamily#) -#endif $(deriveTextShow 'TyFamily#) $(deriveTextShow1 'TyFamily#) $(deriveTextShow2 'TyFamily#) - -#if __GLASGOW_HASKELL__ < 711 -$(Generics.deriveAll0And1 'TyFamily#) -#endif #if MIN_VERSION_base(4,13,0) $(deriveShow1Options legacyShowOptions ''TyCon'#) diff --git a/tests/Derived/PolyKinds.hs b/tests/Derived/PolyKinds.hs --- a/tests/Derived/PolyKinds.hs +++ b/tests/Derived/PolyKinds.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -11,7 +9,7 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Derived.PolyKinds @@ -32,30 +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. @@ -66,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) @@ -82,9 +67,7 @@ deriving ( Arbitrary , Show , Generic -#if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 -#endif ) ------------------------------------------------------------------------------- @@ -93,9 +76,7 @@ deriving ( Arbitrary , Show , Generic -#if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 -#endif ) ------------------------------------------------------------------------------- @@ -116,11 +97,9 @@ 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) @@ -134,9 +113,7 @@ deriving ( Arbitrary , Show , Generic -#if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 -#endif ) ------------------------------------------------------------------------------- @@ -154,9 +131,7 @@ deriving ( Arbitrary , Show , Generic -#if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 -#endif ) ------------------------------------------------------------------------------- @@ -165,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) @@ -186,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) @@ -220,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) @@ -262,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 @@ -284,20 +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 diff --git a/tests/Derived/RankNTypes.hs b/tests/Derived/RankNTypes.hs --- a/tests/Derived/RankNTypes.hs +++ b/tests/Derived/RankNTypes.hs @@ -1,12 +1,11 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-# OPTIONS_GHC -fno-warn-name-shadowing #-} +{-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_GHC -Wno-name-shadowing #-} {-| Module: Derived.RankNTypes @@ -20,25 +19,19 @@ -} module Derived.RankNTypes (TyCon(..), TyFamily(..)) where -import Data.Functor.Classes (Show1(..)) +import Data.Functor.Classes (Show1(..), Show2(..)) import Prelude () import Prelude.Compat import Test.QuickCheck (Arbitrary(..)) -import Text.Show.Deriving (deriveShow1) +import Text.Show.Deriving (deriveShow1, deriveShow2, + makeLiftShowsPrec, makeLiftShowsPrec2) import TextShow (TextShow(..), TextShow1(..), TextShow2(..)) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2, makeShowbPrec, makeLiftShowbPrec, makeLiftShowbPrec2) -#if defined(NEW_FUNCTOR_CLASSES) -import Data.Functor.Classes (Show2(..)) -import Text.Show.Deriving (deriveShow2, makeLiftShowsPrec, makeLiftShowsPrec2) -#else -import Text.Show.Deriving (makeShowsPrec1) -#endif - ------------------------------------------------------------------------------- data TyCon a b = TyCon (forall a. Tagged2 a Int b) @@ -86,31 +79,19 @@ ------------------------------------------------------------------------------- instance Show1 (Tagged2 s t) where -#if defined(NEW_FUNCTOR_CLASSES) liftShowsPrec = $(makeLiftShowsPrec ''Tagged2) -#else - showsPrec1 = $(makeShowsPrec1 ''Tagged2) -#endif -#if defined(NEW_FUNCTOR_CLASSES) instance Show2 (Tagged2 s) where liftShowsPrec2 = $(makeLiftShowsPrec2 ''Tagged2) -#endif $(deriveShow1 ''TyCon) -#if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2 ''TyCon) -#endif $(deriveTextShow ''TyCon) $(deriveTextShow1 ''TyCon) $(deriveTextShow2 ''TyCon) -#if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 'TyFamily) -#else -$(deriveShow1 'TyFamily) $(deriveShow2 'TyFamily) -#endif $(deriveTextShow 'TyFamily) $(deriveTextShow1 'TyFamily) diff --git a/tests/Derived/Records.hs b/tests/Derived/Records.hs --- a/tests/Derived/Records.hs +++ b/tests/Derived/Records.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} @@ -16,12 +14,6 @@ -} 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, Generic1) import Instances.Utils.GenericArbitrary (genericArbitrary) @@ -31,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) @@ -57,9 +46,7 @@ | (:!:) { tf3 :: b, (###) :: a } deriving ( Show , Generic -#if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 -#endif ) ------------------------------------------------------------------------------- @@ -73,26 +60,15 @@ ------------------------------------------------------------------------------- $(deriveShow1 ''TyCon) -#if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2 ''TyCon) -#endif $(deriveTextShow ''TyCon) $(deriveTextShow1 ''TyCon) $(deriveTextShow2 ''TyCon) -#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 diff --git a/tests/Derived/TypeFamilies.hs b/tests/Derived/TypeFamilies.hs --- a/tests/Derived/TypeFamilies.hs +++ b/tests/Derived/TypeFamilies.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} @@ -20,10 +19,7 @@ import Test.QuickCheck (Arbitrary) -import Text.Show.Deriving (deriveShow1) -#if defined(NEW_FUNCTOR_CLASSES) -import Text.Show.Deriving (deriveShow2) -#endif +import Text.Show.Deriving (deriveShow1, deriveShow2) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) @@ -42,11 +38,10 @@ ------------------------------------------------------------------------------- $(deriveShow1 ''TyConOverSat) -$(deriveShow1 'TyFamilyOverSat) -#if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2 ''TyConOverSat) + +$(deriveShow1 'TyFamilyOverSat) $(deriveShow2 'TyFamilyOverSat) -#endif $(deriveTextShow ''TyConOverSat) $(deriveTextShow1 ''TyConOverSat) diff --git a/tests/Derived/TypeSynonyms.hs b/tests/Derived/TypeSynonyms.hs --- a/tests/Derived/TypeSynonyms.hs +++ b/tests/Derived/TypeSynonyms.hs @@ -1,10 +1,8 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Derived.TypeSynonyms @@ -18,20 +16,17 @@ -} module Derived.TypeSynonyms (TyCon(..), TyFamily(..)) where -import Data.Orphans () +import Control.Monad.Trans.Instances () -import qualified Generics.Deriving.TH as Generics +import Data.Orphans () -import GHC.Generics (Generic) +import GHC.Generics (Generic, Generic1) import Prelude import Test.QuickCheck (Arbitrary) -import Text.Show.Deriving (deriveShow1) -#if defined(NEW_FUNCTOR_CLASSES) -import Text.Show.Deriving (deriveShow2) -#endif +import Text.Show.Deriving (deriveShow1, deriveShow2) import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) @@ -52,6 +47,7 @@ deriving ( Arbitrary , Show , Generic + , Generic1 ) ------------------------------------------------------------------------------- @@ -67,43 +63,21 @@ deriving ( Arbitrary , Show , Generic + , Generic1 ) ------------------------------------------------------------------------------- -#if !(MIN_VERSION_base(4,9,0)) --- TODO: Delete this code once we depend on transformers-compat-0.7.1 as the --- minimum -# if !(MIN_VERSION_transformers_compat(0,7,1)) -$(deriveShow1 ''(,,,)) -# if defined(NEW_FUNCTOR_CLASSES) -$(deriveShow2 ''(,,,)) -# endif -# endif -#endif - $(deriveShow1 ''TyCon) -#if defined(NEW_FUNCTOR_CLASSES) $(deriveShow2 ''TyCon) -#endif $(deriveTextShow ''TyCon) $(deriveTextShow1 ''TyCon) $(deriveTextShow2 ''TyCon) -$(Generics.deriveMeta ''TyCon) -$(Generics.deriveRepresentable1 ''TyCon) - -#if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 'TyFamily) -#else -$(deriveShow1 'TyFamily) $(deriveShow2 'TyFamily) -#endif $(deriveTextShow 'TyFamily) $(deriveTextShow1 'TyFamily) $(deriveTextShow2 'TyFamily) - -$(Generics.deriveMeta 'TyFamily) -$(Generics.deriveRepresentable1 'TyFamily) diff --git a/tests/Instances/Control/Concurrent.hs b/tests/Instances/Control/Concurrent.hs --- a/tests/Instances/Control/Concurrent.hs +++ b/tests/Instances/Control/Concurrent.hs @@ -1,6 +1,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Control.Concurrent diff --git a/tests/Instances/Control/Exception.hs b/tests/Instances/Control/Exception.hs --- a/tests/Instances/Control/Exception.hs +++ b/tests/Instances/Control/Exception.hs @@ -2,7 +2,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Control.Exception @@ -83,16 +83,12 @@ instance Arbitrary BlockedIndefinitelyOnSTM where arbitrary = arbitraryBoundedEnum -#if MIN_VERSION_base(4,8,0) deriving instance Bounded AllocationLimitExceeded deriving instance Enum AllocationLimitExceeded instance Arbitrary AllocationLimitExceeded where arbitrary = arbitraryBoundedEnum -#endif -#if MIN_VERSION_base(4,9,0) deriving instance Arbitrary TypeError -#endif #if MIN_VERSION_base(4,10,0) deriving instance Arbitrary CompactionFailed diff --git a/tests/Instances/Control/Monad/ST.hs b/tests/Instances/Control/Monad/ST.hs --- a/tests/Instances/Control/Monad/ST.hs +++ b/tests/Instances/Control/Monad/ST.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Control.Monad.ST diff --git a/tests/Instances/Data/Char.hs b/tests/Instances/Data/Char.hs --- a/tests/Instances/Data/Char.hs +++ b/tests/Instances/Data/Char.hs @@ -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 diff --git a/tests/Instances/Data/Data.hs b/tests/Instances/Data/Data.hs --- a/tests/Instances/Data/Data.hs +++ b/tests/Instances/Data/Data.hs @@ -1,6 +1,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Data.Data diff --git a/tests/Instances/Data/Dynamic.hs b/tests/Instances/Data/Dynamic.hs --- a/tests/Instances/Data/Dynamic.hs +++ b/tests/Instances/Data/Dynamic.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Data.Dynamic diff --git a/tests/Instances/Data/Floating.hs b/tests/Instances/Data/Floating.hs --- a/tests/Instances/Data/Floating.hs +++ b/tests/Instances/Data/Floating.hs @@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Data.Floating diff --git a/tests/Instances/Data/Monoid.hs b/tests/Instances/Data/Monoid.hs --- a/tests/Instances/Data/Monoid.hs +++ b/tests/Instances/Data/Monoid.hs @@ -2,7 +2,7 @@ #if MIN_VERSION_base(4,12,0) {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} #endif {-| Module: Instances.Data.Monoid diff --git a/tests/Instances/Data/OldTypeable.hs b/tests/Instances/Data/OldTypeable.hs deleted file mode 100644 --- a/tests/Instances/Data/OldTypeable.hs +++ /dev/null @@ -1,43 +0,0 @@ -{-# LANGUAGE CPP #-} - -#if !(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,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 diff --git a/tests/Instances/Data/Ord.hs b/tests/Instances/Data/Ord.hs --- a/tests/Instances/Data/Ord.hs +++ b/tests/Instances/Data/Ord.hs @@ -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 diff --git a/tests/Instances/Data/Semigroup.hs b/tests/Instances/Data/Semigroup.hs --- a/tests/Instances/Data/Semigroup.hs +++ b/tests/Instances/Data/Semigroup.hs @@ -1,4 +1,5 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Data.Semigroup @@ -12,9 +13,11 @@ -} module Instances.Data.Semigroup () where -import Data.Semigroup.Compat (Arg(..)) +#if !MIN_VERSION_QuickCheck(2,17,0) +import Data.Semigroup (Arg(..)) import Instances.Utils.GenericArbitrary (genericArbitrary) import Test.QuickCheck (Arbitrary(..)) instance (Arbitrary a, Arbitrary b) => Arbitrary (Arg a b) where arbitrary = genericArbitrary +#endif diff --git a/tests/Instances/Data/Text.hs b/tests/Instances/Data/Text.hs --- a/tests/Instances/Data/Text.hs +++ b/tests/Instances/Data/Text.hs @@ -1,8 +1,7 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -fno-warn-deprecations #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Data.Text @@ -16,27 +15,20 @@ -} module Instances.Data.Text () where -import Data.Text.Encoding.Error (UnicodeException(..)) -import Data.Text.Lazy.Builder (Builder, fromString) - -#if MIN_VERSION_text(1,0,0) import Data.Text.Encoding (Decoding(..)) -import Instances.Utils ((<@>)) -#endif - -#if MIN_VERSION_text(1,1,0) +import Data.Text.Encoding.Error (UnicodeException(..)) import Data.Text.Internal.Fusion.Size (Size, exactSize) -import Test.QuickCheck (getNonNegative) -#endif +import Data.Text.Lazy.Builder (Builder, fromString) import GHC.Generics (Generic) +import Instances.Utils ((<@>)) import Instances.Utils.GenericArbitrary (genericArbitrary) import Prelude () import Prelude.Compat -import Test.QuickCheck (Arbitrary(..)) +import Test.QuickCheck (Arbitrary(..), getNonNegative) import Test.QuickCheck.Instances () instance Arbitrary Builder where @@ -45,14 +37,10 @@ instance Arbitrary UnicodeException where arbitrary = genericArbitrary -#if MIN_VERSION_text(1,0,0) instance Arbitrary Decoding where arbitrary = Some <$> arbitrary <*> arbitrary <@> undefined -#endif -#if MIN_VERSION_text(1,1,0) instance Arbitrary Size where arbitrary = exactSize . getNonNegative <$> arbitrary -#endif deriving instance Generic UnicodeException diff --git a/tests/Instances/Data/Tuple.hs b/tests/Instances/Data/Tuple.hs --- a/tests/Instances/Data/Tuple.hs +++ b/tests/Instances/Data/Tuple.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Data.Tuple diff --git a/tests/Instances/Data/Type/Coercion.hs b/tests/Instances/Data/Type/Coercion.hs --- a/tests/Instances/Data/Type/Coercion.hs +++ b/tests/Instances/Data/Type/Coercion.hs @@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE PolyKinds #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Data.Type.Coercion diff --git a/tests/Instances/Data/Type/Equality.hs b/tests/Instances/Data/Type/Equality.hs --- a/tests/Instances/Data/Type/Equality.hs +++ b/tests/Instances/Data/Type/Equality.hs @@ -1,8 +1,7 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Data.Type.Equality @@ -23,7 +22,5 @@ instance a ~ b => Arbitrary (a :~: b) where arbitrary = arbitraryBoundedEnum -#if MIN_VERSION_base(4,9,0) instance a ~~ b => Arbitrary (a :~~: b) where arbitrary = arbitraryBoundedEnum -#endif diff --git a/tests/Instances/Data/Typeable.hs b/tests/Instances/Data/Typeable.hs --- a/tests/Instances/Data/Typeable.hs +++ b/tests/Instances/Data/Typeable.hs @@ -3,7 +3,7 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Data.Typeable @@ -19,15 +19,11 @@ #include "MachDeps.h" -#if MIN_VERSION_base(4,9,0) import GHC.Types (TyCon(..), TrName(..), Module(..)) -# if MIN_VERSION_base(4,17,0) || WORD_SIZE_IN_BITS < 64 +#if MIN_VERSION_base(4,17,0) || WORD_SIZE_IN_BITS < 64 import GHC.Word (Word64(..)) -# else -import GHC.Word (Word(..)) -# endif #else -import Data.Typeable.Internal (TyCon(..)) +import GHC.Word (Word(..)) #endif #if MIN_VERSION_base(4,10,0) @@ -105,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 MIN_VERSION_base(4,17,0) || 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 diff --git a/tests/Instances/Foreign/C/Types.hs b/tests/Instances/Foreign/C/Types.hs --- a/tests/Instances/Foreign/C/Types.hs +++ b/tests/Instances/Foreign/C/Types.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Foreign.C.Types diff --git a/tests/Instances/Foreign/Ptr.hs b/tests/Instances/Foreign/Ptr.hs --- a/tests/Instances/Foreign/Ptr.hs +++ b/tests/Instances/Foreign/Ptr.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Foreign.Ptr diff --git a/tests/Instances/FromStringTextShow.hs b/tests/Instances/FromStringTextShow.hs --- a/tests/Instances/FromStringTextShow.hs +++ b/tests/Instances/FromStringTextShow.hs @@ -1,7 +1,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.FromStringTextShow diff --git a/tests/Instances/GHC/Conc/Windows.hs b/tests/Instances/GHC/Conc/Windows.hs --- a/tests/Instances/GHC/Conc/Windows.hs +++ b/tests/Instances/GHC/Conc/Windows.hs @@ -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) diff --git a/tests/Instances/GHC/Event.hs b/tests/Instances/GHC/Event.hs --- a/tests/Instances/GHC/Event.hs +++ b/tests/Instances/GHC/Event.hs @@ -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 diff --git a/tests/Instances/GHC/Fingerprint.hs b/tests/Instances/GHC/Fingerprint.hs --- a/tests/Instances/GHC/Fingerprint.hs +++ b/tests/Instances/GHC/Fingerprint.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.GHC.Fingerprint diff --git a/tests/Instances/GHC/Generics.hs b/tests/Instances/GHC/Generics.hs --- a/tests/Instances/GHC/Generics.hs +++ b/tests/Instances/GHC/Generics.hs @@ -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 diff --git a/tests/Instances/GHC/RTS/Flags.hs b/tests/Instances/GHC/RTS/Flags.hs --- a/tests/Instances/GHC/RTS/Flags.hs +++ b/tests/Instances/GHC/RTS/Flags.hs @@ -1,16 +1,14 @@ {-# LANGUAGE CPP #-} - -#if MIN_VERSION_base(4,8,0) {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -# if __GLASGOW_HASKELL__ == 802 +{-# 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 #endif {-| @@ -23,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' @@ -35,9 +30,17 @@ import qualified Generics.Deriving.TH as Generics (deriveAll0) import GHC.RTS.Flags +#if MIN_VERSION_base(4,21,0) +import qualified GHC.IO.SubSystem as SubSystem +#elif MIN_VERSION_base(4,15,0) +import qualified GHC.RTS.Flags as SubSystem +#endif import Instances.Utils.GenericArbitrary (genericArbitrary) import Language.Haskell.TH.Lib (conT) import Test.QuickCheck (Arbitrary(..)) +#if MIN_VERSION_base(4,21,0) +import Test.QuickCheck (arbitraryBoundedEnum) +#endif import TextShow.TH.Names #if !(MIN_VERSION_base(4,15,0)) @@ -61,7 +64,7 @@ #endif #if MIN_VERSION_base(4,15,0) -$(Generics.deriveAll0 ''IoSubSystem) +$(Generics.deriveAll0 ''SubSystem.IoSubSystem) #endif instance Arbitrary RTSFlags where @@ -74,10 +77,16 @@ arbitrary = genericArbitrary #if MIN_VERSION_base(4,15,0) -instance Arbitrary IoSubSystem where +instance Arbitrary SubSystem.IoSubSystem where arbitrary = genericArbitrary #endif +#if MIN_VERSION_base(4,21,0) +deriving instance Bounded IoManagerFlag +instance Arbitrary IoManagerFlag where + arbitrary = arbitraryBoundedEnum +#endif + instance Arbitrary MiscFlags where arbitrary = genericArbitrary @@ -96,11 +105,16 @@ instance Arbitrary TickyFlags where arbitrary = genericArbitrary -# if MIN_VERSION_base(4,10,0) +#if MIN_VERSION_base(4,10,0) instance Arbitrary ParFlags where arbitrary = genericArbitrary -# endif +#endif +#if MIN_VERSION_base(4,20,0) +instance Arbitrary HpcFlags where + arbitrary = genericArbitrary +#endif + type GiveGCStats' = $(conT giveGCStatsTypeName) type DoCostCentres' = $(conT doCostCentresTypeName) type DoHeapProfile' = $(conT doHeapProfileTypeName) @@ -117,4 +131,3 @@ instance Arbitrary DoTrace' where arbitrary = genericArbitrary -#endif diff --git a/tests/Instances/GHC/Stack.hs b/tests/Instances/GHC/Stack.hs --- a/tests/Instances/GHC/Stack.hs +++ b/tests/Instances/GHC/Stack.hs @@ -1,11 +1,7 @@ -{-# LANGUAGE CPP #-} - -#if MIN_VERSION_base(4,8,1) -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -#endif +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.GHC.Stack @@ -19,41 +15,27 @@ -} module Instances.GHC.Stack () where -#if MIN_VERSION_base(4,8,1) -# if MIN_VERSION_base(4,9,0) import GHC.Stack.Types (CallStack(..), SrcLoc(..)) import Instances.Utils ((<@>)) import Test.QuickCheck (oneof) -# else -import GHC.SrcLoc (SrcLoc) -import GHC.Stack (CallStack) -# endif -# if !(MIN_VERSION_base(4,15,0)) -import qualified Generics.Deriving.TH as Generics (deriveAll0) -# endif +#if !(MIN_VERSION_base(4,15,0)) +import GHC.Generics (Generic) +#endif import Instances.Utils.GenericArbitrary (genericArbitrary) import Test.QuickCheck (Arbitrary(..)) -# if !(MIN_VERSION_base(4,9,0)) -$(Generics.deriveAll0 ''CallStack) -# endif -# if !(MIN_VERSION_base(4,15,0)) -$(Generics.deriveAll0 ''SrcLoc) -# endif +#if !(MIN_VERSION_base(4,15,0)) +deriving instance Generic SrcLoc +#endif instance Arbitrary CallStack where -# if MIN_VERSION_base(4,9,0) arbitrary = oneof [ pure EmptyCallStack , PushCallStack <$> arbitrary <*> arbitrary <@> EmptyCallStack , pure $ FreezeCallStack EmptyCallStack ] -# else - arbitrary = genericArbitrary -# endif instance Arbitrary SrcLoc where arbitrary = genericArbitrary -#endif diff --git a/tests/Instances/GHC/StaticPtr.hs b/tests/Instances/GHC/StaticPtr.hs --- a/tests/Instances/GHC/StaticPtr.hs +++ b/tests/Instances/GHC/StaticPtr.hs @@ -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 diff --git a/tests/Instances/GHC/Stats.hs b/tests/Instances/GHC/Stats.hs --- a/tests/Instances/GHC/Stats.hs +++ b/tests/Instances/GHC/Stats.hs @@ -3,8 +3,8 @@ #if !(MIN_VERSION_base(4,11,0)) {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -fno-warn-deprecations #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +{-# OPTIONS_GHC -Wno-orphans #-} #endif {-| diff --git a/tests/Instances/GHC/TypeLits.hs b/tests/Instances/GHC/TypeLits.hs --- a/tests/Instances/GHC/TypeLits.hs +++ b/tests/Instances/GHC/TypeLits.hs @@ -1,5 +1,6 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE PolyKinds #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.GHC.TypeLits @@ -19,7 +20,13 @@ import Prelude.Compat import Test.QuickCheck (Arbitrary(..), getNonNegative) +import Test.QuickCheck.Instances () +#if MIN_VERSION_base(4,18,0) +import qualified GHC.TypeNats as TN +import Spec.Utils (GArbitrary(..), Some(..)) +#endif + instance Arbitrary SomeNat where arbitrary = do nat <- getNonNegative <$> arbitrary @@ -29,3 +36,25 @@ instance Arbitrary SomeSymbol where arbitrary = someSymbolVal <$> arbitrary + +#if MIN_VERSION_base(4,16,0) +instance Arbitrary SomeChar where + arbitrary = someCharVal <$> arbitrary +#endif + +#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 diff --git a/tests/Instances/Generic.hs b/tests/Instances/Generic.hs --- a/tests/Instances/Generic.hs +++ b/tests/Instances/Generic.hs @@ -6,7 +6,7 @@ #if __GLASGOW_HASKELL__ >= 806 {-# LANGUAGE DerivingVia #-} #endif -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Generic diff --git a/tests/Instances/Options.hs b/tests/Instances/Options.hs --- a/tests/Instances/Options.hs +++ b/tests/Instances/Options.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Options diff --git a/tests/Instances/System/IO.hs b/tests/Instances/System/IO.hs --- a/tests/Instances/System/IO.hs +++ b/tests/Instances/System/IO.hs @@ -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 diff --git a/tests/Instances/System/Posix/Types.hs b/tests/Instances/System/Posix/Types.hs --- a/tests/Instances/System/Posix/Types.hs +++ b/tests/Instances/System/Posix/Types.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.System.Posix.Types diff --git a/tests/Instances/Text/Read.hs b/tests/Instances/Text/Read.hs --- a/tests/Instances/Text/Read.hs +++ b/tests/Instances/Text/Read.hs @@ -3,7 +3,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} {-| Module: Instances.Text.Read diff --git a/tests/Instances/Utils/GenericArbitrary.hs b/tests/Instances/Utils/GenericArbitrary.hs --- a/tests/Instances/Utils/GenericArbitrary.hs +++ b/tests/Instances/Utils/GenericArbitrary.hs @@ -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 diff --git a/tests/Spec/Control/ApplicativeSpec.hs b/tests/Spec/Control/ApplicativeSpec.hs --- a/tests/Spec/Control/ApplicativeSpec.hs +++ b/tests/Spec/Control/ApplicativeSpec.hs @@ -14,9 +14,7 @@ import Control.Monad.Trans.Instances () import Data.Orphans () -import Data.Proxy.Compat (Proxy(..)) - -import Generics.Deriving.Instances () +import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShowSpec, matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec) diff --git a/tests/Spec/Control/ConcurrentSpec.hs b/tests/Spec/Control/ConcurrentSpec.hs --- a/tests/Spec/Control/ConcurrentSpec.hs +++ b/tests/Spec/Control/ConcurrentSpec.hs @@ -12,7 +12,7 @@ import Control.Concurrent (myThreadId) -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import GHC.Conc (BlockReason, ThreadStatus) diff --git a/tests/Spec/Control/ExceptionSpec.hs b/tests/Spec/Control/ExceptionSpec.hs --- a/tests/Spec/Control/ExceptionSpec.hs +++ b/tests/Spec/Control/ExceptionSpec.hs @@ -16,7 +16,7 @@ #if MIN_VERSION_base(4,11,0) import Control.Exception.Base (FixIOException) #endif -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Instances.Control.Exception () import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) @@ -48,14 +48,10 @@ matchesTextShowSpec (Proxy :: Proxy BlockedIndefinitelyOnMVar) describe "BlockedIndefinitelyOnSTM" $ matchesTextShowSpec (Proxy :: Proxy BlockedIndefinitelyOnSTM) -#if MIN_VERSION_base(4,8,0) describe "AllocationLimitExceeded" $ matchesTextShowSpec (Proxy :: Proxy AllocationLimitExceeded) -#endif -#if MIN_VERSION_base(4,9,0) describe "TypeError" $ matchesTextShowSpec (Proxy :: Proxy TypeError) -#endif #if MIN_VERSION_base(4,10,0) describe "CompactionFailed" $ matchesTextShowSpec (Proxy :: Proxy CompactionFailed) diff --git a/tests/Spec/Control/Monad/STSpec.hs b/tests/Spec/Control/Monad/STSpec.hs --- a/tests/Spec/Control/Monad/STSpec.hs +++ b/tests/Spec/Control/Monad/STSpec.hs @@ -1,7 +1,7 @@ module Spec.Control.Monad.STSpec (main, spec) where import Control.Monad.ST -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Instances.Control.Monad.ST () import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) diff --git a/tests/Spec/Data/Array/ByteSpec.hs b/tests/Spec/Data/Array/ByteSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Spec/Data/Array/ByteSpec.hs @@ -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 diff --git a/tests/Spec/Data/ArraySpec.hs b/tests/Spec/Data/ArraySpec.hs --- a/tests/Spec/Data/ArraySpec.hs +++ b/tests/Spec/Data/ArraySpec.hs @@ -18,10 +18,10 @@ import Test.Hspec (Spec, hspec, parallel) import Test.QuickCheck.Instances () -#if !defined(mingw32_HOST_OS) && MIN_VERSION_text(1,0,0) +#if !defined(mingw32_HOST_OS) import Data.Array (Array) import Data.Array.Unboxed (UArray) -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShowSpec) @@ -33,7 +33,7 @@ spec :: Spec spec = parallel $ do -#if !defined(mingw32_HOST_OS) && MIN_VERSION_text(1,0,0) +#if !defined(mingw32_HOST_OS) -- TODO: Figure out why these tests diverge on Windows describe "Array Int Int" $ matchesTextShowSpec (Proxy :: Proxy (Array Int Int)) diff --git a/tests/Spec/Data/BoolSpec.hs b/tests/Spec/Data/BoolSpec.hs --- a/tests/Spec/Data/BoolSpec.hs +++ b/tests/Spec/Data/BoolSpec.hs @@ -12,7 +12,7 @@ -} module Spec.Data.BoolSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShowSpec, genericTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) diff --git a/tests/Spec/Data/ByteStringSpec.hs b/tests/Spec/Data/ByteStringSpec.hs --- a/tests/Spec/Data/ByteStringSpec.hs +++ b/tests/Spec/Data/ByteStringSpec.hs @@ -13,7 +13,7 @@ import qualified Data.ByteString as BS (ByteString) import qualified Data.ByteString.Lazy as BL (ByteString) import Data.ByteString.Short (ShortByteString) -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShowSpec) diff --git a/tests/Spec/Data/CharSpec.hs b/tests/Spec/Data/CharSpec.hs --- a/tests/Spec/Data/CharSpec.hs +++ b/tests/Spec/Data/CharSpec.hs @@ -12,7 +12,7 @@ import Data.Array (elems) import Data.Char (GeneralCategory) -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import GHC.Show (asciiTab) diff --git a/tests/Spec/Data/ComplexSpec.hs b/tests/Spec/Data/ComplexSpec.hs --- a/tests/Spec/Data/ComplexSpec.hs +++ b/tests/Spec/Data/ComplexSpec.hs @@ -11,7 +11,7 @@ module Spec.Data.ComplexSpec (main, spec) where import Data.Complex (Complex) -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShowSpec) diff --git a/tests/Spec/Data/DataSpec.hs b/tests/Spec/Data/DataSpec.hs --- a/tests/Spec/Data/DataSpec.hs +++ b/tests/Spec/Data/DataSpec.hs @@ -11,7 +11,7 @@ module Spec.Data.DataSpec (main, spec) where import Data.Data (Constr, ConstrRep, DataRep, DataType, Fixity) -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Instances.Data.Data () diff --git a/tests/Spec/Data/DynamicSpec.hs b/tests/Spec/Data/DynamicSpec.hs --- a/tests/Spec/Data/DynamicSpec.hs +++ b/tests/Spec/Data/DynamicSpec.hs @@ -11,7 +11,7 @@ module Spec.Data.DynamicSpec (main, spec) where import Data.Dynamic (Dynamic) -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Instances.Data.Dynamic () diff --git a/tests/Spec/Data/EitherSpec.hs b/tests/Spec/Data/EitherSpec.hs --- a/tests/Spec/Data/EitherSpec.hs +++ b/tests/Spec/Data/EitherSpec.hs @@ -10,8 +10,7 @@ -} module Spec.Data.EitherSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) -import Generics.Deriving.Instances () +import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) diff --git a/tests/Spec/Data/FixedSpec.hs b/tests/Spec/Data/FixedSpec.hs --- a/tests/Spec/Data/FixedSpec.hs +++ b/tests/Spec/Data/FixedSpec.hs @@ -11,7 +11,7 @@ module Spec.Data.FixedSpec (main, spec) where import Data.Fixed (Fixed, E0, E1, E2, E3, E6, E9, E12, showFixed) -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShowSpec) diff --git a/tests/Spec/Data/FloatingSpec.hs b/tests/Spec/Data/FloatingSpec.hs --- a/tests/Spec/Data/FloatingSpec.hs +++ b/tests/Spec/Data/FloatingSpec.hs @@ -12,13 +12,13 @@ -} module Spec.Data.FloatingSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Data.Text.Lazy.Builder.RealFloat (FPFormat) import Instances.Data.Floating () -import Numeric.Compat (showEFloat, showFFloat, showGFloat, - showFFloatAlt, showGFloatAlt) +import Numeric (showEFloat, showFFloat, showGFloat, + showFFloatAlt, showGFloatAlt) import Prelude () import Prelude.Compat diff --git a/tests/Spec/Data/Functor/ComposeSpec.hs b/tests/Spec/Data/Functor/ComposeSpec.hs --- a/tests/Spec/Data/Functor/ComposeSpec.hs +++ b/tests/Spec/Data/Functor/ComposeSpec.hs @@ -13,7 +13,7 @@ import Control.Monad.Trans.Instances () import Data.Functor.Compose (Compose) -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShow1Spec) diff --git a/tests/Spec/Data/Functor/IdentitySpec.hs b/tests/Spec/Data/Functor/IdentitySpec.hs --- a/tests/Spec/Data/Functor/IdentitySpec.hs +++ b/tests/Spec/Data/Functor/IdentitySpec.hs @@ -13,7 +13,7 @@ import Control.Monad.Trans.Instances () import Data.Functor.Identity (Identity) -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShow1Spec) diff --git a/tests/Spec/Data/Functor/ProductSpec.hs b/tests/Spec/Data/Functor/ProductSpec.hs --- a/tests/Spec/Data/Functor/ProductSpec.hs +++ b/tests/Spec/Data/Functor/ProductSpec.hs @@ -13,7 +13,7 @@ import Control.Monad.Trans.Instances () import Data.Functor.Product (Product) -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShow1Spec) diff --git a/tests/Spec/Data/Functor/SumSpec.hs b/tests/Spec/Data/Functor/SumSpec.hs --- a/tests/Spec/Data/Functor/SumSpec.hs +++ b/tests/Spec/Data/Functor/SumSpec.hs @@ -13,7 +13,7 @@ import Control.Monad.Trans.Instances () import Data.Functor.Sum (Sum) -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShow1Spec) diff --git a/tests/Spec/Data/IntegralSpec.hs b/tests/Spec/Data/IntegralSpec.hs --- a/tests/Spec/Data/IntegralSpec.hs +++ b/tests/Spec/Data/IntegralSpec.hs @@ -13,7 +13,7 @@ module Spec.Data.IntegralSpec (main, spec) where import Data.Int (Int8, Int16, Int32, Int64) -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Data.Word (Word8, Word16, Word32, Word64) import Prelude () @@ -23,9 +23,7 @@ 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) @@ -65,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) +#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 "") `shouldBe` showbIntAtBase base intToDigit i #endif diff --git a/tests/Spec/Data/List/NonEmptySpec.hs b/tests/Spec/Data/List/NonEmptySpec.hs --- a/tests/Spec/Data/List/NonEmptySpec.hs +++ b/tests/Spec/Data/List/NonEmptySpec.hs @@ -10,8 +10,8 @@ -} module Spec.Data.List.NonEmptySpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) -import Data.List.NonEmpty.Compat (NonEmpty) +import Data.Proxy (Proxy(..)) +import Data.List.NonEmpty (NonEmpty) import Data.Orphans () import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) diff --git a/tests/Spec/Data/ListSpec.hs b/tests/Spec/Data/ListSpec.hs --- a/tests/Spec/Data/ListSpec.hs +++ b/tests/Spec/Data/ListSpec.hs @@ -10,7 +10,7 @@ -} module Spec.Data.ListSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShowSpec) diff --git a/tests/Spec/Data/MaybeSpec.hs b/tests/Spec/Data/MaybeSpec.hs --- a/tests/Spec/Data/MaybeSpec.hs +++ b/tests/Spec/Data/MaybeSpec.hs @@ -11,7 +11,7 @@ module Spec.Data.MaybeSpec (main, spec) where import Data.Orphans () -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec) diff --git a/tests/Spec/Data/MonoidSpec.hs b/tests/Spec/Data/MonoidSpec.hs --- a/tests/Spec/Data/MonoidSpec.hs +++ b/tests/Spec/Data/MonoidSpec.hs @@ -13,9 +13,7 @@ module Spec.Data.MonoidSpec (main, spec) where import Data.Monoid -import Data.Proxy.Compat (Proxy(..)) - -import Generics.Deriving.Instances () +import Data.Proxy (Proxy(..)) import Instances.Data.Monoid () @@ -68,14 +66,12 @@ matchesTextShowSpec p genericTextShowSpec p genericTextShow1Spec p -#if MIN_VERSION_base(4,8,0) describe "Alt Maybe Int" $ do let p :: Proxy (Alt Maybe Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p genericTextShow1Spec p -#endif #if MIN_VERSION_base(4,12,0) describe "Ap Maybe Int" $ do let p :: Proxy (Ap Maybe Int) diff --git a/tests/Spec/Data/OldTypeableSpec.hs b/tests/Spec/Data/OldTypeableSpec.hs deleted file mode 100644 --- a/tests/Spec/Data/OldTypeableSpec.hs +++ /dev/null @@ -1,47 +0,0 @@ -{-# LANGUAGE CPP #-} - -#if !(MIN_VERSION_base(4,8,0)) -{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -#endif - -{-| -Module: Spec.Data.OldTypeableSpec -Copyright: (C) 2014-2017 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Provisional -Portability: GHC - -@hspec@ tests for data types in the "Data.OldTypeable" module. --} -module Spec.Data.OldTypeableSpec (main, spec) where - -import Instances.Data.OldTypeable () - -import Prelude () -import Prelude.Compat - -import Test.Hspec (Spec, hspec, parallel) - -#if !(MIN_VERSION_base(4,8,0)) -import Data.OldTypeable (TyCon, TypeRep) -import Data.Proxy.Compat (Proxy(..)) - -import Spec.Utils (matchesTextShowSpec) - -import Test.Hspec (describe) -#endif - -main :: IO () -main = hspec spec - -spec :: Spec -spec = parallel $ do -#if !(MIN_VERSION_base(4,8,0)) - describe "TypeRep" $ - matchesTextShowSpec (Proxy :: Proxy TypeRep) - describe "TyCon" $ - matchesTextShowSpec (Proxy :: Proxy TyCon) -#else - pure () -#endif diff --git a/tests/Spec/Data/OrdSpec.hs b/tests/Spec/Data/OrdSpec.hs --- a/tests/Spec/Data/OrdSpec.hs +++ b/tests/Spec/Data/OrdSpec.hs @@ -11,9 +11,7 @@ module Spec.Data.OrdSpec (main, spec) where import Data.Orphans () -import Data.Proxy.Compat (Proxy(..)) - -import Generics.Deriving.Instances () +import Data.Proxy (Proxy(..)) import GHC.Exts (Down) diff --git a/tests/Spec/Data/ProxySpec.hs b/tests/Spec/Data/ProxySpec.hs --- a/tests/Spec/Data/ProxySpec.hs +++ b/tests/Spec/Data/ProxySpec.hs @@ -10,9 +10,7 @@ -} module Spec.Data.ProxySpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) - -import Generics.Deriving.Base () +import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShowSpec, genericTextShowSpec) diff --git a/tests/Spec/Data/RatioSpec.hs b/tests/Spec/Data/RatioSpec.hs --- a/tests/Spec/Data/RatioSpec.hs +++ b/tests/Spec/Data/RatioSpec.hs @@ -10,7 +10,7 @@ -} module Spec.Data.RatioSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Data.Ratio (Ratio) import Spec.Utils (matchesTextShowSpec) diff --git a/tests/Spec/Data/SemigroupSpec.hs b/tests/Spec/Data/SemigroupSpec.hs --- a/tests/Spec/Data/SemigroupSpec.hs +++ b/tests/Spec/Data/SemigroupSpec.hs @@ -10,8 +10,8 @@ -} module Spec.Data.SemigroupSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) -import Data.Semigroup.Compat (Min, Max, First, Last, WrappedMonoid, Arg) +import Data.Proxy (Proxy(..)) +import Data.Semigroup (Min, Max, First, Last, WrappedMonoid, Arg) import Instances.Data.Semigroup () diff --git a/tests/Spec/Data/TextSpec.hs b/tests/Spec/Data/TextSpec.hs --- a/tests/Spec/Data/TextSpec.hs +++ b/tests/Spec/Data/TextSpec.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - {-| Module: Spec.Data.TextSpec Copyright: (C) 2014-2017 Ryan Scott @@ -12,7 +10,7 @@ -} module Spec.Data.TextSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Instances.Data.Text () @@ -22,13 +20,9 @@ import qualified Data.Text as TS import qualified Data.Text as TL -#if MIN_VERSION_text(1,0,0) import Data.Text.Encoding (Decoding) -#endif import Data.Text.Encoding.Error (UnicodeException) -#if MIN_VERSION_text(1,1,0) import Data.Text.Internal.Fusion.Size (Size) -#endif import Data.Text.Lazy.Builder (Builder) main :: IO () @@ -44,11 +38,7 @@ matchesTextShowSpec (Proxy :: Proxy TL.Text) describe "UnicodeException" $ matchesTextShowSpec (Proxy :: Proxy UnicodeException) -#if MIN_VERSION_text(1,0,0) describe "Decoding" $ matchesTextShowSpec (Proxy :: Proxy Decoding) -#endif -#if MIN_VERSION_text(1,1,0) describe "Size" $ matchesTextShowSpec (Proxy :: Proxy Size) -#endif diff --git a/tests/Spec/Data/TupleSpec.hs b/tests/Spec/Data/TupleSpec.hs --- a/tests/Spec/Data/TupleSpec.hs +++ b/tests/Spec/Data/TupleSpec.hs @@ -12,9 +12,8 @@ -} module Spec.Data.TupleSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) -import Generics.Deriving.Instances () -#if MIN_VERSION_ghc_prim(0,7,0) +import Data.Proxy (Proxy(..)) +#if MIN_VERSION_ghc_prim(0,7,0) && MIN_VERSION_base(4,16,0) import GHC.Tuple (Solo) #endif import Instances.Data.Tuple () @@ -85,7 +84,7 @@ 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) +#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 diff --git a/tests/Spec/Data/Type/CoercionSpec.hs b/tests/Spec/Data/Type/CoercionSpec.hs --- a/tests/Spec/Data/Type/CoercionSpec.hs +++ b/tests/Spec/Data/Type/CoercionSpec.hs @@ -13,7 +13,7 @@ module Spec.Data.Type.CoercionSpec (main, spec) where import Data.Monoid (All(..)) -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Data.Type.Coercion (Coercion) import Instances.Data.Type.Coercion () diff --git a/tests/Spec/Data/Type/EqualitySpec.hs b/tests/Spec/Data/Type/EqualitySpec.hs --- a/tests/Spec/Data/Type/EqualitySpec.hs +++ b/tests/Spec/Data/Type/EqualitySpec.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE TypeOperators #-} {-| @@ -13,7 +12,7 @@ -} module Spec.Data.Type.EqualitySpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Data.Type.Equality.Compat import Instances.Data.Type.Equality () @@ -33,7 +32,5 @@ spec = parallel $ do describe "Int :~: Int" $ matchesTextShowSpec (Proxy :: Proxy (Int :~: Int)) -# if MIN_VERSION_base(4,9,0) describe "Int :~~: Int" $ matchesTextShowSpec (Proxy :: Proxy (Int :~~: Int)) -# endif diff --git a/tests/Spec/Data/TypeableSpec.hs b/tests/Spec/Data/TypeableSpec.hs --- a/tests/Spec/Data/TypeableSpec.hs +++ b/tests/Spec/Data/TypeableSpec.hs @@ -13,12 +13,10 @@ -} module Spec.Data.TypeableSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Data.Typeable (TyCon) -#if MIN_VERSION_base(4,9,0) import GHC.Types (TrName, Module) -#endif #if MIN_VERSION_base(4,10,0) import Data.Kind (Type) @@ -40,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]" $ @@ -62,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 diff --git a/tests/Spec/Data/VersionSpec.hs b/tests/Spec/Data/VersionSpec.hs --- a/tests/Spec/Data/VersionSpec.hs +++ b/tests/Spec/Data/VersionSpec.hs @@ -1,6 +1,6 @@ module Spec.Data.VersionSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Data.Version (Version, showVersion) import Spec.Utils (matchesTextShowSpec) diff --git a/tests/Spec/Derived/DataFamiliesSpec.hs b/tests/Spec/Derived/DataFamiliesSpec.hs --- a/tests/Spec/Derived/DataFamiliesSpec.hs +++ b/tests/Spec/Derived/DataFamiliesSpec.hs @@ -12,7 +12,7 @@ -} module Spec.Derived.DataFamiliesSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Derived.DataFamilies (NotAllShow, KindDistinguished, NullaryData) diff --git a/tests/Spec/Derived/DatatypeContextsSpec.hs b/tests/Spec/Derived/DatatypeContextsSpec.hs --- a/tests/Spec/Derived/DatatypeContextsSpec.hs +++ b/tests/Spec/Derived/DatatypeContextsSpec.hs @@ -10,7 +10,7 @@ -} module Spec.Derived.DatatypeContextsSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Derived.DatatypeContexts import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) diff --git a/tests/Spec/Derived/ExistentialQuantificationSpec.hs b/tests/Spec/Derived/ExistentialQuantificationSpec.hs --- a/tests/Spec/Derived/ExistentialQuantificationSpec.hs +++ b/tests/Spec/Derived/ExistentialQuantificationSpec.hs @@ -10,7 +10,7 @@ -} module Spec.Derived.ExistentialQuantificationSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Derived.ExistentialQuantification import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) diff --git a/tests/Spec/Derived/InfixSpec.hs b/tests/Spec/Derived/InfixSpec.hs --- a/tests/Spec/Derived/InfixSpec.hs +++ b/tests/Spec/Derived/InfixSpec.hs @@ -10,7 +10,7 @@ -} module Spec.Derived.InfixSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Derived.Infix import Spec.Utils (matchesTextShowSpec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) diff --git a/tests/Spec/Derived/MagicHashSpec.hs b/tests/Spec/Derived/MagicHashSpec.hs --- a/tests/Spec/Derived/MagicHashSpec.hs +++ b/tests/Spec/Derived/MagicHashSpec.hs @@ -1,5 +1,9 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} +#if __GLASGOW_HASKELL__ == 800 +-- See Note [Increased simpl-tick-factor on old GHCs] in TextShow.Data.Complex +{-# OPTIONS_GHC -fsimpl-tick-factor=250 #-} +#endif {-| Module: Spec.Derived.MagicHashSpec @@ -13,7 +17,7 @@ -} module Spec.Derived.MagicHashSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Derived.MagicHash import Spec.Utils import Test.Hspec (Spec, describe, hspec, parallel) diff --git a/tests/Spec/Derived/PolyKindsSpec.hs b/tests/Spec/Derived/PolyKindsSpec.hs --- a/tests/Spec/Derived/PolyKindsSpec.hs +++ b/tests/Spec/Derived/PolyKindsSpec.hs @@ -10,7 +10,7 @@ -} module Spec.Derived.PolyKindsSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Derived.PolyKinds import Spec.Utils (matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) diff --git a/tests/Spec/Derived/RankNTypesSpec.hs b/tests/Spec/Derived/RankNTypesSpec.hs --- a/tests/Spec/Derived/RankNTypesSpec.hs +++ b/tests/Spec/Derived/RankNTypesSpec.hs @@ -10,7 +10,7 @@ -} module Spec.Derived.RankNTypesSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Derived.RankNTypes import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) diff --git a/tests/Spec/Derived/RecordsSpec.hs b/tests/Spec/Derived/RecordsSpec.hs --- a/tests/Spec/Derived/RecordsSpec.hs +++ b/tests/Spec/Derived/RecordsSpec.hs @@ -1,3 +1,9 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ == 800 +-- See Note [Increased simpl-tick-factor on old GHCs] in TextShow.Data.Complex +{-# OPTIONS_GHC -fsimpl-tick-factor=200 #-} +#endif + {-| Module: Spec.Derived.RecordsSpec Copyright: (C) 2014-2017 Ryan Scott @@ -10,7 +16,7 @@ -} module Spec.Derived.RecordsSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Derived.Records import Spec.Utils (matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) diff --git a/tests/Spec/Derived/TypeFamiliesSpec.hs b/tests/Spec/Derived/TypeFamiliesSpec.hs --- a/tests/Spec/Derived/TypeFamiliesSpec.hs +++ b/tests/Spec/Derived/TypeFamiliesSpec.hs @@ -10,7 +10,7 @@ -} module Spec.Derived.TypeFamiliesSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Derived.TypeFamilies diff --git a/tests/Spec/Derived/TypeSynonymsSpec.hs b/tests/Spec/Derived/TypeSynonymsSpec.hs --- a/tests/Spec/Derived/TypeSynonymsSpec.hs +++ b/tests/Spec/Derived/TypeSynonymsSpec.hs @@ -10,7 +10,7 @@ -} module Spec.Derived.TypeSynonymsSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Derived.TypeSynonyms import Spec.Utils (matchesTextShowSpec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) diff --git a/tests/Spec/Foreign/C/TypesSpec.hs b/tests/Spec/Foreign/C/TypesSpec.hs --- a/tests/Spec/Foreign/C/TypesSpec.hs +++ b/tests/Spec/Foreign/C/TypesSpec.hs @@ -12,7 +12,7 @@ -} module Spec.Foreign.C.TypesSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Foreign.C.Types import Instances.Foreign.C.Types () import Spec.Utils (matchesTextShowSpec) diff --git a/tests/Spec/Foreign/PtrSpec.hs b/tests/Spec/Foreign/PtrSpec.hs --- a/tests/Spec/Foreign/PtrSpec.hs +++ b/tests/Spec/Foreign/PtrSpec.hs @@ -10,7 +10,7 @@ -} module Spec.Foreign.PtrSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Foreign.ForeignPtr (newForeignPtr_) import Foreign.Ptr (FunPtr, IntPtr, Ptr, WordPtr) diff --git a/tests/Spec/FromStringTextShowSpec.hs b/tests/Spec/FromStringTextShowSpec.hs --- a/tests/Spec/FromStringTextShowSpec.hs +++ b/tests/Spec/FromStringTextShowSpec.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - {-| Module: Spec.FromStringTextShowSpec Copyright: (C) 2014-2017 Ryan Scott @@ -12,17 +10,14 @@ -} module Spec.FromStringTextShowSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Instances.FromStringTextShow () -import Spec.Utils (matchesTextShowSpec, matchesTextShow1Spec) +import Spec.Utils (matchesTextShowSpec, matchesTextShow1Spec, + matchesTextShow2Spec) import Test.Hspec (Spec, describe, hspec, parallel) -import TextShow (FromStringShow(..), FromTextShow(..)) - -#if defined(NEW_FUNCTOR_CLASSES) -import Spec.Utils (matchesTextShow2Spec) -import TextShow (FromStringShow1(..), FromStringShow2(..), +import TextShow (FromStringShow(..), FromTextShow(..), + FromStringShow1(..), FromStringShow2(..), FromTextShow1(..), FromTextShow2(..)) -#endif main :: IO () main = hspec spec @@ -33,43 +28,31 @@ let p :: Proxy (FromStringShow Int) p = Proxy matchesTextShowSpec p - matchesTextShow1Spec p describe "FromStringShow String" $ do let p :: Proxy (FromStringShow String) p = Proxy matchesTextShowSpec p - matchesTextShow1Spec p describe "FromTextShow Int" $ do let p :: Proxy (FromTextShow Int) p = Proxy matchesTextShowSpec p - matchesTextShow1Spec p describe "FromTextShow String" $ do let p :: Proxy (FromTextShow String) p = Proxy matchesTextShowSpec p - matchesTextShow1Spec p -#if defined(NEW_FUNCTOR_CLASSES) describe "FromStringShow1 Maybe Int" $ do let p :: Proxy (FromStringShow1 Maybe Int) p = Proxy - matchesTextShowSpec p matchesTextShow1Spec p describe "FromTextShow1 Maybe Int" $ do let p :: Proxy (FromTextShow1 Maybe Int) p = Proxy - matchesTextShowSpec p matchesTextShow1Spec p describe "FromStringShow2 Either Char Int" $ do let p :: Proxy (FromStringShow2 Either Char Int) p = Proxy - matchesTextShowSpec p - matchesTextShow1Spec p matchesTextShow2Spec p describe "FromTextShow2 Either Char Int" $ do let p :: Proxy (FromTextShow2 Either Char Int) p = Proxy - matchesTextShowSpec p - matchesTextShow1Spec p matchesTextShow2Spec p -#endif diff --git a/tests/Spec/FunctionsSpec.hs b/tests/Spec/FunctionsSpec.hs --- a/tests/Spec/FunctionsSpec.hs +++ b/tests/Spec/FunctionsSpec.hs @@ -10,7 +10,7 @@ -} module Spec.FunctionsSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) import Text.Show.Functions () diff --git a/tests/Spec/GHC/Conc/WindowsSpec.hs b/tests/Spec/GHC/Conc/WindowsSpec.hs --- a/tests/Spec/GHC/Conc/WindowsSpec.hs +++ b/tests/Spec/GHC/Conc/WindowsSpec.hs @@ -19,8 +19,8 @@ import Test.Hspec (Spec, hspec, parallel) -#if !defined(__GHCJS__) && defined(mingw32_HOST_OS) -import Data.Proxy.Compat (Proxy(..)) +#if !defined(__GHCJS__) && !defined(ghcjs_HOST_OS) && defined(mingw32_HOST_OS) +import Data.Proxy (Proxy(..)) import GHC.Conc.Windows (ConsoleEvent) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe) @@ -31,7 +31,7 @@ spec :: Spec spec = parallel $ -#if !defined(__GHCJS__) && defined(mingw32_HOST_OS) +#if !defined(__GHCJS__) && !defined(ghcjs_HOST_OS) && defined(mingw32_HOST_OS) describe "ConsoleEvent" $ matchesTextShowSpec (Proxy :: Proxy ConsoleEvent) #else diff --git a/tests/Spec/GHC/EventSpec.hs b/tests/Spec/GHC/EventSpec.hs --- a/tests/Spec/GHC/EventSpec.hs +++ b/tests/Spec/GHC/EventSpec.hs @@ -19,13 +19,10 @@ import Test.Hspec (Spec, hspec, parallel) -#if !defined(__GHCJS__) && !defined(mingw32_HOST_OS) -import Data.Proxy.Compat (Proxy(..)) +#if !defined(__GHCJS__) && !defined(ghcjs_HOST_OS) && !defined(mingw32_HOST_OS) +import Data.Proxy (Proxy(..)) -import GHC.Event (Event) -# if MIN_VERSION_base(4,8,1) -import GHC.Event (Lifetime) -#endif +import GHC.Event (Event, Lifetime) import Spec.Utils (matchesTextShowSpec) @@ -38,15 +35,13 @@ spec :: Spec spec = parallel $ do -#if !defined(__GHCJS__) && !defined(mingw32_HOST_OS) +#if !defined(__GHCJS__) && !defined(ghcjs_HOST_OS) && !defined(mingw32_HOST_OS) describe "Event" $ matchesTextShowSpec (Proxy :: Proxy Event) -- describe "FdKey" $ -- matchesTextShowSpec (Proxy :: Proxy FdKey) -# if MIN_VERSION_base(4,8,1) describe "Lifetime" $ matchesTextShowSpec (Proxy :: Proxy Lifetime) -# endif #else pure () #endif diff --git a/tests/Spec/GHC/FingerprintSpec.hs b/tests/Spec/GHC/FingerprintSpec.hs --- a/tests/Spec/GHC/FingerprintSpec.hs +++ b/tests/Spec/GHC/FingerprintSpec.hs @@ -10,7 +10,7 @@ -} module Spec.GHC.FingerprintSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Data.Orphans () import GHC.Fingerprint.Type (Fingerprint) diff --git a/tests/Spec/GHC/GenericsSpec.hs b/tests/Spec/GHC/GenericsSpec.hs --- a/tests/Spec/GHC/GenericsSpec.hs +++ b/tests/Spec/GHC/GenericsSpec.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeOperators #-} @@ -15,18 +14,14 @@ module Spec.GHC.GenericsSpec (main, spec) where import Data.Orphans () -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) -import Generics.Deriving.Base ( U1, Par1, Rec1, K1, M1, (:+:), (:*:), (:.:) - , UChar, UDouble, UFloat, UInt, UWord - , Fixity, Associativity -#if MIN_VERSION_base(4,9,0) - , Meta(MetaData), SourceUnpackedness - , SourceStrictness, DecidedStrictness -#else - , Arity -#endif - ) +import GHC.Generics ( U1, Par1, Rec1, K1, M1, (:+:), (:*:), (:.:) + , UChar, UDouble, UFloat, UInt, UWord + , Fixity, Associativity + , Meta(MetaData), SourceUnpackedness + , SourceStrictness, DecidedStrictness + ) import Instances.GHC.Generics () @@ -37,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 @@ -61,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 @@ -77,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 diff --git a/tests/Spec/GHC/RTS/FlagsSpec.hs b/tests/Spec/GHC/RTS/FlagsSpec.hs --- a/tests/Spec/GHC/RTS/FlagsSpec.hs +++ b/tests/Spec/GHC/RTS/FlagsSpec.hs @@ -12,35 +12,37 @@ -} module Spec.GHC.RTS.FlagsSpec (main, spec) where -import Prelude () -import Prelude.Compat - -import Test.Hspec (Spec, hspec, parallel) +import Data.Proxy (Proxy(..)) -#if MIN_VERSION_base(4,8,0) -import Data.Proxy.Compat (Proxy(..)) import GHC.RTS.Flags + import Instances.GHC.RTS.Flags + +import Prelude () +import Prelude.Compat + import Spec.Utils (matchesTextShowSpec) -import Test.Hspec (describe) -#endif +import Test.Hspec (Spec, describe, hspec, parallel) + main :: IO () main = hspec spec spec :: Spec spec = parallel $ do -#if MIN_VERSION_base(4,8,0) describe "RTSFlags" $ matchesTextShowSpec (Proxy :: Proxy RTSFlags) describe "GCFlags" $ matchesTextShowSpec (Proxy :: Proxy GCFlags) describe "ConcFlags" $ matchesTextShowSpec (Proxy :: Proxy ConcFlags) -# if MIN_VERSION_base(4,15,0) +#if MIN_VERSION_base(4,21,0) + describe "IoManagerFlag" $ + matchesTextShowSpec (Proxy :: Proxy IoManagerFlag) +#elif MIN_VERSION_base(4,15,0) describe "IoSubSystem" $ matchesTextShowSpec (Proxy :: Proxy IoSubSystem) -# endif +#endif describe "MiscFlags" $ matchesTextShowSpec (Proxy :: Proxy MiscFlags) describe "DebugFlags" $ @@ -61,10 +63,7 @@ matchesTextShowSpec (Proxy :: Proxy DoHeapProfile') describe "DoTrace" $ matchesTextShowSpec (Proxy :: Proxy DoTrace') -# if MIN_VERSION_base(4,10,0) +#if MIN_VERSION_base(4,10,0) describe "ParFlags" $ matchesTextShowSpec (Proxy :: Proxy ParFlags) -# endif -#else - pure () #endif diff --git a/tests/Spec/GHC/StackSpec.hs b/tests/Spec/GHC/StackSpec.hs --- a/tests/Spec/GHC/StackSpec.hs +++ b/tests/Spec/GHC/StackSpec.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - {-| Module: Spec.GHC.StackSpec Copyright: (C) 2014-2017 Ryan Scott @@ -12,37 +10,25 @@ -} module Spec.GHC.StackSpec (main, spec) where +import Data.Proxy (Proxy(..)) + +import GHC.Stack (CallStack, SrcLoc) + import Instances.GHC.Stack () import Prelude () import Prelude.Compat -import Test.Hspec (Spec, hspec, parallel) - -#if MIN_VERSION_base(4,8,1) -import Data.Proxy.Compat (Proxy(..)) -import GHC.Stack (CallStack) -# if MIN_VERSION_base(4,9,0) -import GHC.Stack (SrcLoc) -# else -import GHC.SrcLoc (SrcLoc) -# endif - import Spec.Utils (matchesTextShowSpec) -import Test.Hspec (describe) -#endif +import Test.Hspec (Spec, describe, hspec, parallel) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do -#if MIN_VERSION_base(4,8,1) describe "CallStack" $ matchesTextShowSpec (Proxy :: Proxy CallStack) describe "SrcLoc" $ matchesTextShowSpec (Proxy :: Proxy SrcLoc) -#else - pure () -#endif diff --git a/tests/Spec/GHC/StaticPtrSpec.hs b/tests/Spec/GHC/StaticPtrSpec.hs --- a/tests/Spec/GHC/StaticPtrSpec.hs +++ b/tests/Spec/GHC/StaticPtrSpec.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - {-| Module: Spec.GHC.StaticPtrSpec Copyright: (C) 2014-2017 Ryan Scott @@ -12,28 +10,23 @@ -} module Spec.GHC.StaticPtrSpec (main, spec) where +import Data.Proxy (Proxy(..)) + +import GHC.StaticPtr (StaticPtrInfo) + import Instances.GHC.StaticPtr () import Prelude () import Prelude.Compat -import Test.Hspec (Spec, hspec, parallel) - -#if MIN_VERSION_base(4,8,0) -import Data.Proxy.Compat (Proxy(..)) -import GHC.StaticPtr (StaticPtrInfo) import Spec.Utils (matchesTextShowSpec) -import Test.Hspec (describe) -#endif +import Test.Hspec (Spec, describe, hspec, parallel) + main :: IO () main = hspec spec spec :: Spec spec = parallel $ -#if MIN_VERSION_base(4,8,0) describe "StaticPtrInfo" $ matchesTextShowSpec (Proxy :: Proxy StaticPtrInfo) -#else - pure () -#endif diff --git a/tests/Spec/GHC/StatsSpec.hs b/tests/Spec/GHC/StatsSpec.hs --- a/tests/Spec/GHC/StatsSpec.hs +++ b/tests/Spec/GHC/StatsSpec.hs @@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-deprecations #-} +{-# OPTIONS_GHC -Wno-deprecations #-} {-| Module: Spec.GHC.StatsSpec @@ -21,7 +21,7 @@ import Test.Hspec (Spec, hspec, parallel) #if !(MIN_VERSION_base(4,11,0)) -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import GHC.Stats (GCStats) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe) diff --git a/tests/Spec/GHC/TypeLitsSpec.hs b/tests/Spec/GHC/TypeLitsSpec.hs --- a/tests/Spec/GHC/TypeLitsSpec.hs +++ b/tests/Spec/GHC/TypeLitsSpec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-| @@ -12,7 +13,7 @@ -} module Spec.GHC.TypeLitsSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import GHC.TypeLits @@ -22,6 +23,9 @@ import Prelude.Compat import Spec.Utils (matchesTextShowSpec) +#if MIN_VERSION_base(4,18,0) +import Spec.Utils (Some) +#endif import Test.Hspec (Spec, describe, hspec, parallel) @@ -34,3 +38,15 @@ matchesTextShowSpec (Proxy :: Proxy SomeNat) describe "SomeSymbol" $ matchesTextShowSpec (Proxy :: Proxy SomeSymbol) +#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 diff --git a/tests/Spec/GenericSpec.hs b/tests/Spec/GenericSpec.hs --- a/tests/Spec/GenericSpec.hs +++ b/tests/Spec/GenericSpec.hs @@ -10,7 +10,7 @@ -} module Spec.GenericSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Instances.Generic () import Instances.Utils (GenericExample) import Spec.Utils (matchesTextShowSpec, matchesTextShow1Spec, genericTextShowSpec) diff --git a/tests/Spec/Numeric/NaturalSpec.hs b/tests/Spec/Numeric/NaturalSpec.hs --- a/tests/Spec/Numeric/NaturalSpec.hs +++ b/tests/Spec/Numeric/NaturalSpec.hs @@ -10,8 +10,8 @@ -} module Spec.Numeric.NaturalSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) -import Numeric.Natural.Compat (Natural) +import Data.Proxy (Proxy(..)) +import Numeric.Natural (Natural) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) import Test.QuickCheck.Instances () diff --git a/tests/Spec/OptionsSpec.hs b/tests/Spec/OptionsSpec.hs --- a/tests/Spec/OptionsSpec.hs +++ b/tests/Spec/OptionsSpec.hs @@ -10,7 +10,7 @@ -} module Spec.OptionsSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Instances.Options () import Spec.Utils (matchesTextShowSpec, genericTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) diff --git a/tests/Spec/System/ExitSpec.hs b/tests/Spec/System/ExitSpec.hs --- a/tests/Spec/System/ExitSpec.hs +++ b/tests/Spec/System/ExitSpec.hs @@ -10,7 +10,7 @@ -} module Spec.System.ExitSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Spec.Utils (matchesTextShowSpec) import System.Exit (ExitCode) import Test.Hspec (Spec, describe, hspec, parallel) diff --git a/tests/Spec/System/IOSpec.hs b/tests/Spec/System/IOSpec.hs --- a/tests/Spec/System/IOSpec.hs +++ b/tests/Spec/System/IOSpec.hs @@ -10,7 +10,7 @@ -} module Spec.System.IOSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import GHC.IO.Encoding.Failure (CodingFailureMode) import GHC.IO.Encoding.Types (CodingProgress) diff --git a/tests/Spec/System/Posix/TypesSpec.hs b/tests/Spec/System/Posix/TypesSpec.hs --- a/tests/Spec/System/Posix/TypesSpec.hs +++ b/tests/Spec/System/Posix/TypesSpec.hs @@ -12,7 +12,7 @@ -} module Spec.System.Posix.TypesSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Instances.System.Posix.Types () import Spec.Utils (matchesTextShowSpec) import System.Posix.Types diff --git a/tests/Spec/Text/ReadSpec.hs b/tests/Spec/Text/ReadSpec.hs --- a/tests/Spec/Text/ReadSpec.hs +++ b/tests/Spec/Text/ReadSpec.hs @@ -10,7 +10,7 @@ -} module Spec.Text.ReadSpec (main, spec) where -import Data.Proxy.Compat (Proxy(..)) +import Data.Proxy (Proxy(..)) import Instances.Text.Read () import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) diff --git a/tests/Spec/Utils.hs b/tests/Spec/Utils.hs --- a/tests/Spec/Utils.hs +++ b/tests/Spec/Utils.hs @@ -1,7 +1,14 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +#if __GLASGOW_HASKELL__ >= 806 +{-# LANGUAGE QuantifiedConstraints #-} +#endif + {-| Module: Spec.Utils Copyright: (C) 2014-2017 Ryan Scott @@ -16,94 +23,122 @@ matchesTextShowSpec , prop_matchesTextShow , matchesTextShow1Spec -#if defined(NEW_FUNCTOR_CLASSES) , matchesTextShow2Spec -#endif , genericTextShowSpec , genericTextShow1Spec + + , Some(..) + , GArbitrary(..) ) where -import Data.Functor.Classes (Show1, showsPrec1) -import Data.Proxy.Compat (Proxy(..)) +import Data.Functor.Classes (Show1, Show2, showsPrec1, showsPrec2) +import Data.Proxy (Proxy(..)) -import Generics.Deriving.Base +import GHC.Generics +import GHC.Stack (HasCallStack) import Test.Hspec (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 -> 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 -> Expectation -prop_matchesTextShow p x = fromString (showsPrec p x "") `shouldBe` 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 -> 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 -> Expectation -prop_matchesTextShow1 p x = fromString (showsPrec1 p x "") `shouldBe` 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 -> 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) +prop_matchesTextShow2 :: (HasCallStack, Show2 f, Show a, Show b, TextShow2 f, TextShow a, TextShow b) => Int -> f a b -> Expectation -prop_matchesTextShow2 p x = fromString (showsPrec2 p x "") `shouldBe` showbPrec2 p x -#endif +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 -> 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)) +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 -> 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 -> Expectation prop_genericTextShow1 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) diff --git a/text-show.cabal b/text-show.cabal --- a/text-show.cabal +++ b/text-show.cabal @@ -1,20 +1,11 @@ name: text-show -version: 3.9.7 +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 @@. . - At the moment, @text-show@ provides instances for most data - types in the @@, - @@, - @@, and - @@ packages. - Therefore, much of the source code for @text-show@ consists of - borrowed code from those packages in order to ensure that the - behaviors of @Show@ and @TextShow@ coincide. - . For most uses, simply importing "TextShow" will suffice: . @@ -33,6 +24,24 @@ . Support for automatically deriving @TextShow@ instances can be found in the "TextShow.TH" and "TextShow.Generic" modules. + . + @text-show@ only provides instances for data types in the + following packages: + . + * @@ + . + * @@ + . + * @@ + . + * @@ + . + 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 + @@ + library. + homepage: https://github.com/RyanGlScott/text-show bug-reports: https://github.com/RyanGlScott/text-show/issues license: BSD3 @@ -43,38 +52,27 @@ copyright: (C) 2014-2017 Ryan Scott category: Text build-type: Simple -tested-with: GHC == 7.8.4 - , GHC == 7.10.3 - , GHC == 8.0.2 +tested-with: GHC == 8.0.2 , GHC == 8.2.2 , GHC == 8.4.4 , GHC == 8.6.5 , GHC == 8.8.4 , GHC == 8.10.7 , GHC == 9.0.2 - , GHC == 9.2.2 -extra-source-files: CHANGELOG.md, README.md, include/*.h + , GHC == 9.2.8 + , GHC == 9.4.8 + , GHC == 9.6.7 + , GHC == 9.8.4 + , GHC == 9.10.3 + , GHC == 9.12.2 + , GHC == 9.14.1 +extra-source-files: CHANGELOG.md, README.md cabal-version: >=1.10 source-repository head type: git location: https://github.com/RyanGlScott/text-show -flag base-4-9 - description: Use base-4.9 or later. - default: True - -flag template-haskell-2-11 - description: Use template-haskell-2.11.0.0 or later. - default: True - -flag new-functor-classes - description: Use a version of transformers or transformers-compat with a - modern-style Data.Functor.Classes module. This flag cannot be - used when building with transformers-0.4, since it comes with - a different version of Data.Functor.Classes. - default: True - flag integer-gmp description: When building with a version of GHC older than 9.0, depend on the @integer-gmp@ library. You can disable @@ -89,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 @@ -117,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 @@ -125,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 @@ -137,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 @@ -161,36 +150,17 @@ TextShow.TH.Internal TextShow.TH.Names TextShow.Utils - build-depends: array >= 0.3 && < 0.6 - , base-compat-batteries >= 0.11 && < 0.13 - , bifunctors >= 5.1 && < 6 - , bytestring >= 0.9 && < 0.12 - , bytestring-builder - , containers >= 0.1 && < 0.7 - , generic-deriving >= 1.14.1 && < 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 - , text >= 0.11.1 && < 2.1 - , th-abstraction >= 0.4 && < 0.5 - , th-lift >= 0.7.6 && < 1 - - if flag(base-4-9) - build-depends: base >= 4.9 && < 4.17 - cpp-options: "-DNEW_FUNCTOR_CLASSES" - else - build-depends: base >= 4.7 && < 4.9 - - if flag(template-haskell-2-11) - build-depends: template-haskell >= 2.11 && < 2.19 - , ghc-boot-th >= 8.0 && < 9.3 - else - build-depends: template-haskell >= 2.9 && < 2.11 - - if flag(new-functor-classes) - build-depends: transformers (>= 0.2.1 && < 0.4) || (>= 0.5 && < 0.7) - , transformers-compat >= 0.5 && < 1 - cpp-options: "-DNEW_FUNCTOR_CLASSES" - else - build-depends: transformers == 0.4.* + , template-haskell >= 2.11 && < 2.25 + , text >= 1.1 && < 2.2 + , th-abstraction >= 0.5 && < 0.8 -- 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. @@ -204,8 +174,6 @@ ghc-options: -Wno-star-is-type if impl(ghc >= 9.0) ghc-options: -fenable-th-splice-warnings - include-dirs: include - includes: generic.h test-suite spec type: exitcode-stdio-1.0 @@ -233,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 @@ -252,22 +226,6 @@ -- Only exports instances if not using Windows Instances.GHC.Event - -- Only exports instances if base >= 4.6 - Instances.GHC.TypeLits - - -- Only exports instances if base >= 4.7 - Instances.Data.Type.Coercion - Instances.Data.Type.Equality - -- Only exports instances if base >= 4.7 && < 4.8 - Instances.Data.OldTypeable - - -- Only exports instances if base >= 4.8 - Instances.GHC.RTS.Flags - Instances.GHC.StaticPtr - - -- Only exports instances if base >= 4.9 - Instances.GHC.Stack - -- Only exports instances if base >= 4.12 Instances.Data.Monoid @@ -277,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 @@ -301,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 @@ -320,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 @@ -334,52 +299,24 @@ -- Only exports tests if not using Windows Spec.GHC.EventSpec - -- Only exports tests if base >= 4.6 - Spec.GHC.TypeLitsSpec - - -- Only exports tests if base >= 4.7 - Spec.Data.Type.CoercionSpec - Spec.Data.Type.EqualitySpec - -- Only exports tests if base >= 4.7 && < 4.8 - Spec.Data.OldTypeableSpec - - -- Only exports tests if base >= 4.8 - Spec.GHC.RTS.FlagsSpec - Spec.GHC.StaticPtrSpec - - -- Only exports tests if base >= 4.9 - Spec.GHC.StackSpec - TextShow.TH.Names - build-depends: array >= 0.3 && < 0.6 - , base-compat-batteries >= 0.11 && < 0.13 - , base-orphans >= 0.8.5 && < 0.9 - , bytestring >= 0.9 && < 0.12 - , bytestring-builder - , deriving-compat >= 0.6 && < 1 - , generic-deriving >= 1.14.1 && < 2 + build-depends: array >= 0.3 && < 0.6 + , base >= 4.9 && < 4.23 + , base-compat-batteries >= 0.11 && < 0.16 + , base-orphans >= 0.8.5 && < 0.10 + , bytestring >= 0.10.8.1 && < 0.13 + , deriving-compat >= 0.6.5 && < 1 + , generic-deriving >= 1.14.1 && < 2 , ghc-prim - , hspec >= 2 && < 3 - , QuickCheck >= 2.12 && < 2.15 - , quickcheck-instances >= 0.3.26 && < 0.4 - , template-haskell >= 2.9 && < 2.19 - , text >= 0.11.1 && < 2.1 + , hspec >= 2 && < 3 + , QuickCheck >= 2.14.3 && < 2.19 + , quickcheck-instances >= 0.3.28 && < 0.5 + , template-haskell >= 2.11 && < 2.25 + , text >= 1.1 && < 2.2 , text-show - , transformers-compat >= 0.5 && < 1 + , transformers-compat >= 0.5 && < 1 build-tool-depends: hspec-discover:hspec-discover - if flag(base-4-9) - build-depends: base >= 4.9 && < 4.17 - cpp-options: "-DNEW_FUNCTOR_CLASSES" - else - build-depends: base >= 4.7 && < 4.9 - - if flag(new-functor-classes) - build-depends: transformers (>= 0.2.1 && < 0.4) || (>= 0.5 && < 0.7) - cpp-options: "-DNEW_FUNCTOR_CLASSES" - else - build-depends: transformers == 0.4.* - hs-source-dirs: tests, shared default-language: Haskell2010 ghc-options: -Wall -threaded -rtsopts @@ -387,19 +324,15 @@ ghc-options: -Wno-star-is-type if impl(ghc >= 9.0) ghc-options: -fenable-th-splice-warnings - include-dirs: include - includes: generic.h - , overlap.h benchmark bench type: exitcode-stdio-1.0 main-is: Bench.hs - build-depends: base >= 4.5 && < 4.17 + build-depends: base >= 4.9 && < 4.23 , criterion >= 1.1.4 && < 2 , deepseq >= 1.3 && < 2 - , ghc-prim , text-show - , text >= 0.11.1 && < 2.1 + , text >= 1.1 && < 2.2 hs-source-dirs: benchmarks default-language: Haskell2010