diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +### 3.6.2 [2017.06.18] +* Drop support for GHC 7.0 and 7.2 +* Require `QuickCheck-2.10`/`quickcheck-instances-0.13.6` or later + ### 3.6 [2017.04.22] * Introduce some 'TextShow' instances for datatypes added in `base-4.10.0.0`: * `CBool` (from `Foreign.C.Types`) 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 @@ -12,13 +12,11 @@ Template Haskell names to eliminate some boilerplate. -} module TextShow.TH.Names ( -#if MIN_VERSION_base(4,4,0) evtCloseValName, eventIsValName, fdKeyTypeName, uniqueTypeName, asInt64ValName, -#endif #if MIN_VERSION_base(4,6,0) numberTypeName, #endif @@ -30,9 +28,7 @@ #endif ) where -#if MIN_VERSION_base(4,4,0) import Language.Haskell.TH.Syntax -#endif #if MIN_VERSION_base(4,7,0) import Text.Read.Lex (Number) @@ -44,7 +40,6 @@ ------------------------------------------------------------------------------- -#if MIN_VERSION_base(4,4,0) -- | Creates a 'Name' for a value from the "GHC.Event.Internal" module. mkEventName_v :: String -> Name mkEventName_v = mkNameG_v "base" "GHC.Event.Internal" @@ -67,11 +62,10 @@ -- | 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,10,0) asInt64ValName = mkNameG_v "base" "GHC.Event.Unique" "asInt" -# else +#else asInt64ValName = mkNameG_v "base" "GHC.Event.Unique" "asInt64" -# endif #endif #if MIN_VERSION_base(4,6,0) 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 #-} + {-| Module: TextShow.Data.Ratio Copyright: (C) 2014-2017 Ryan Scott @@ -11,9 +11,6 @@ 'TextShow' instances for 'Ratio'. -Due to use of the @DatatypeContexts@ extension, there is no @TextShow1 Complex@ -instance on @base-4.3.0.0@. - /Since: 2/ -} module TextShow.Data.Complex () where @@ -22,30 +19,14 @@ import TextShow.Classes (TextShow(..)) import TextShow.Data.Floating () -import TextShow.TH.Internal (makeShowbPrec) -#if MIN_VERSION_base(4,4,0) -import TextShow.TH.Internal (deriveTextShow1) -#endif +import TextShow.TH.Internal (deriveTextShow1, makeShowbPrec) --- | Note that on @base-4.3.0.0@, this must have a @('TextShow' a, --- 'RealFloat' a)@ constraint instead of just a @('TextShow' a)@ constraint. --- --- /Since: 2/ -instance -#if MIN_VERSION_base(4,4,0) - TextShow a -#else - (RealFloat a, TextShow a) -#endif - => TextShow (Complex a) where +-- | /Since: 2/ +instance TextShow a => TextShow (Complex a) where {-# SPECIALIZE instance TextShow (Complex Float) #-} {-# SPECIALIZE instance TextShow (Complex Double) #-} showbPrec = $(makeShowbPrec ''Complex) {-# INLINE showbPrec #-} -#if MIN_VERSION_base(4,4,0) --- | Only available with @base-4.4.0.0@ or later. --- --- /Since: 2/ +-- | /Since: 2/ $(deriveTextShow1 ''Complex) -#endif 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,6 +1,6 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} + {-| Module: TextShow.Data.Ratio Copyright: (C) 2014-2017 Ryan Scott @@ -19,23 +19,11 @@ import GHC.Real (Ratio(..), ratioPrec, ratioPrec1) -import TextShow.Classes (TextShow(..), showbParen) -#if MIN_VERSION_base(4,4,0) -import TextShow.Classes (TextShow1(..)) -#endif +import TextShow.Classes (TextShow(..), TextShow1(..), showbParen) import TextShow.Data.Integral () --- | Note that on @base-4.3.0.0@, this must have a @('TextShow' a, 'Integral' a)@ --- constraint instead of just a @('TextShow' a)@ constraint. --- --- /Since: 2/ -instance -#if MIN_VERSION_base(4,4,0) - TextShow a -#else - (TextShow a, Integral a) -#endif - => TextShow (Ratio a) where +-- | /Since: 2/ +instance TextShow a => TextShow (Ratio a) where {-# SPECIALIZE instance TextShow Rational #-} showbPrec p (numer :% denom) = showbParen (p > ratioPrec) $ showbPrec ratioPrec1 numer @@ -43,14 +31,10 @@ <> showbPrec ratioPrec1 denom {-# INLINE showbPrec #-} -#if MIN_VERSION_base(4,4,0) --- | Only available with @base-4.4.0.0@ or later. --- --- /Since: 2/ +-- | /Since: 2/ instance TextShow1 Ratio where liftShowbPrec sp _ p (numer :% denom) = showbParen (p > ratioPrec) $ sp ratioPrec1 numer <> " % " <> sp ratioPrec1 denom {-# INLINE liftShowbPrec #-} -#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 @@ -50,31 +50,25 @@ import Data.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (fromString, singleton) import Data.Typeable (TypeRep, typeRepArgs, typeRepTyCon) -# if MIN_VERSION_base(4,4,0) import Data.Typeable.Internal (tyConName) -# if MIN_VERSION_base(4,8,0) +# if MIN_VERSION_base(4,8,0) import Data.Typeable.Internal (typeRepKinds) -# endif -# if MIN_VERSION_base(4,9,0) +# 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) -# elif MIN_VERSION_base(4,4,0) -import Data.Typeable.Internal (funTc, listTc) -# endif # else -import Data.Typeable (mkTyCon, tyConString, typeOf) +import Data.Typeable.Internal (funTc, listTc) # endif # if MIN_VERSION_base(4,9,0) import GHC.Exts (Char(..)) import GHC.Prim (Addr#, (+#), eqChar#, indexCharOffAddr#) import GHC.Types (TyCon(..), TrName(..), Module(..), isTrue#) -# elif MIN_VERSION_base(4,4,0) -import Data.Typeable.Internal (TyCon) # else -import Data.Typeable (TyCon) +import Data.Typeable.Internal (TyCon) # endif import TextShow.Classes (TextShow(..), showbParen, showbSpace) @@ -102,7 +96,7 @@ tc'Unlifted :: TyCon tc'Unlifted = tyConOf (Proxy :: Proxy 'PtrRepUnlifted) -# elif MIN_VERSION_base(4,4,0) +# else -- | The list 'TyCon'. tcList :: TyCon tcList = listTc @@ -110,30 +104,14 @@ -- | The function (@->@) 'TyCon'. tcFun :: TyCon tcFun = funTc -# else --- | The list 'TyCon'. -tcList :: TyCon -tcList = typeRepTyCon $ typeOf [()] - --- | The function (@->@) 'TyCon'. -tcFun :: TyCon -tcFun = mkTyCon "->" # endif #endif -- | Does the 'TyCon' represent a tuple type constructor? isTupleTyCon :: TyCon -> Bool -isTupleTyCon = isTupleString . tyConString +isTupleTyCon = isTupleString . tyConName {-# INLINE isTupleTyCon #-} -#if MIN_VERSION_base(4,4,0) --- | Identical to 'tyConName'. Defined to avoid using excessive amounts of pragmas --- with base-4.3 and earlier, which use 'tyConString'. -tyConString :: TyCon -> String -tyConString = tyConName -{-# INLINE tyConString #-} -#endif - #if MIN_VERSION_base(4,10,0) -- | Only available with @base-4.10.0.0@ or later. -- @@ -240,7 +218,7 @@ #elif MIN_VERSION_base(4,9,0) showb (TyCon _ _ _ tc_name) = showb tc_name #else - showb = fromString . tyConString + showb = fromString . tyConName #endif #if MIN_VERSION_base(4,9,0) diff --git a/src/TextShow/Debug/Trace.hs b/src/TextShow/Debug/Trace.hs --- a/src/TextShow/Debug/Trace.hs +++ b/src/TextShow/Debug/Trace.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE OverloadedStrings #-} + {-| Module: TextShow.Debug.Trace Copyright: (C) 2014-2017 Ryan Scott @@ -30,24 +31,20 @@ , tracetlId , traceTextShow , traceTextShowId -#if MIN_VERSION_base(4,5,0) , tracetStack , tracetlStack -#endif , tracetIO , tracetlIO , tracetM , tracetlM , traceTextShowM -#if MIN_VERSION_base(4,5,0) -- * Eventlog tracing -- $eventlog_tracing , tracetEvent , tracetlEvent , tracetEventIO , tracetlEventIO -#endif #if MIN_VERSION_base(4,7,0) -- * Execution phase markers -- $markers @@ -62,23 +59,18 @@ import qualified Data.ByteString as BS (null, partition) import Data.ByteString (ByteString, useAsCString) +import qualified Data.ByteString.Char8 as BS (pack) import Data.ByteString.Internal (c2w) -import qualified Data.Text as TS (Text) +import qualified Data.Text as TS (Text, unpack) import Data.Text.Encoding (encodeUtf8) -import qualified Data.Text.Lazy as TL (Text) +import qualified Data.Text.Lazy as TL (Text, unpack) import Data.Text.Lazy (toStrict) -import Foreign.C.String (CString) - -#if MIN_VERSION_base(4,5,0) -import qualified Data.ByteString.Char8 as BS (pack) -import qualified Data.Text as TS (unpack) -import qualified Data.Text.Lazy as TL (unpack) - import Debug.Trace +import Foreign.C.String (CString) + import GHC.Stack (currentCallStack, renderStack) -#endif import Prelude () import Prelude.Compat @@ -232,7 +224,6 @@ traceTextShowM :: (TextShow a, Applicative f) => a -> f () traceTextShowM = tracetM . showt -#if MIN_VERSION_base(4,5,0) -- | Like 'tracet' but additionally prints a call stack if one is -- available. -- @@ -307,7 +298,6 @@ -- /Since: 2/ tracetlEventIO :: TL.Text -> IO () tracetlEventIO = traceEventIO . TL.unpack -#endif #if MIN_VERSION_base(4,7,0) -- $markers 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,9 +1,8 @@ {-# LANGUAGE CPP #-} -#if MIN_VERSION_base(4,5,0) {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} -#endif {-# OPTIONS_GHC -fno-warn-orphans #-} + {-| Module: TextShow.Foreign.C.Types Copyright: (C) 2014-2017 Ryan Scott @@ -25,17 +24,6 @@ import TextShow.Data.Floating () import TextShow.Data.Integral () -#if !(MIN_VERSION_base(4,5,0)) -import Data.Int -import Data.Text.Lazy.Builder (Builder) -import Data.Word - -import Unsafe.Coerce (unsafeCoerce) - -# include "HsBaseConfig.h" -#endif - -#if MIN_VERSION_base(4,5,0) -- | /Since: 2/ deriving instance TextShow CChar -- | /Since: 2/ @@ -78,129 +66,18 @@ deriving instance TextShow CClock -- | /Since: 2/ deriving instance TextShow CTime --- | Only available with @base-4.4.0.0@ or later. --- --- /Since: 2/ +-- | /Since: 2/ deriving instance TextShow CUSeconds --- | Only available with @base-4.4.0.0@ or later. --- --- /Since: 2/ +-- | /Since: 2/ deriving instance TextShow CSUSeconds -- | /Since: 2/ deriving instance TextShow CFloat -- | /Since: 2/ deriving instance TextShow CDouble -# if MIN_VERSION_base(4,10,0) --- | Only available with @base-4.4.0.0@ or later. +#if MIN_VERSION_base(4,10,0) +-- | Only available with @base-4.10.0.0@ or later. -- -- /Since: 3.6/ deriving instance TextShow CBool -# endif -#else --- | /Since: 2/ -instance TextShow CChar where - showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_CHAR -> Builder) - --- | /Since: 2/ -instance TextShow CSChar where - showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_SIGNED_CHAR -> Builder) - --- | /Since: 2/ -instance TextShow CUChar where - showb = unsafeCoerce (showb :: HTYPE_UNSIGNED_CHAR -> Builder) - --- | /Since: 2/ -instance TextShow CShort where - showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_SHORT -> Builder) - --- | /Since: 2/ -instance TextShow CUShort where - showb = unsafeCoerce (showb :: HTYPE_UNSIGNED_SHORT -> Builder) - --- | /Since: 2/ -instance TextShow CInt where - showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_INT -> Builder) - --- | /Since: 2/ -instance TextShow CUInt where - showb = unsafeCoerce (showb :: HTYPE_UNSIGNED_INT -> Builder) - --- | /Since: 2/ -instance TextShow CLong where - showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_LONG -> Builder) - --- | /Since: 2/ -instance TextShow CULong where - showb = unsafeCoerce (showb :: HTYPE_UNSIGNED_LONG -> Builder) - --- | /Since: 2/ -instance TextShow CPtrdiff where - showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_PTRDIFF_T -> Builder) - --- | /Since: 2/ -instance TextShow CSize where - showb = unsafeCoerce (showb :: HTYPE_SIZE_T -> Builder) - --- | /Since: 2/ -instance TextShow CWchar where - showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_WCHAR_T -> Builder) - --- | /Since: 2/ -instance TextShow CSigAtomic where - showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_SIG_ATOMIC_T -> Builder) - --- | /Since: 2/ -instance TextShow CLLong where - showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_LONG_LONG -> Builder) - --- | /Since: 2/ -instance TextShow CULLong where - showb = unsafeCoerce (showb :: HTYPE_UNSIGNED_LONG_LONG -> Builder) - --- | /Since: 2/ -instance TextShow CIntPtr where - showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_INTPTR_T -> Builder) - --- | /Since: 2/ -instance TextShow CUIntPtr where - showb = unsafeCoerce (showb :: HTYPE_UINTPTR_T -> Builder) - --- | /Since: 2/ -instance TextShow CIntMax where - showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_INTMAX_T -> Builder) - --- | /Since: 2/ -instance TextShow CUIntMax where - showb = unsafeCoerce (showb :: HTYPE_UINTMAX_T -> Builder) - --- | /Since: 2/ -instance TextShow CClock where - showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_CLOCK_T -> Builder) - --- | /Since: 2/ -instance TextShow CTime where - showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_TIME_T -> Builder) - -# if MIN_VERSION_base(4,4,0) --- | Only available with @base-4.4.0.0@ or later. --- --- /Since: 2/ -instance TextShow CUSeconds where - showb = unsafeCoerce (showb :: HTYPE_USECONDS_T -> Builder) - --- | Only available with @base-4.4.0.0@ or later. --- --- /Since: 2/ -instance TextShow CSUSeconds where - showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_SUSECONDS_T -> Builder) -# endif - --- | /Since: 2/ -instance TextShow CFloat where - showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_FLOAT -> Builder) - --- | /Since: 2/ -instance TextShow CDouble where - showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_DOUBLE -> Builder) #endif diff --git a/src/TextShow/FromStringTextShow.hs b/src/TextShow/FromStringTextShow.hs --- a/src/TextShow/FromStringTextShow.hs +++ b/src/TextShow/FromStringTextShow.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -10,10 +11,6 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} - -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE DeriveGeneric #-} -#endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} 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,6 +1,6 @@ {-# LANGUAGE CPP #-} -#if !defined(__GHCJS__) && !defined(mingw32_HOST_OS) && MIN_VERSION_base(4,4,0) +#if !defined(__GHCJS__) && !defined(mingw32_HOST_OS) {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -14,14 +14,13 @@ Portability: GHC 'TextShow' instances for data types in the @Event@ module. -Only provided if using @base-4.4.0.0@ on a platform other -than Windows or GHCJS. +Only provided if using a platform other than Windows or GHCJS. /Since: 2/ -} module TextShow.GHC.Event () where -#if !defined(__GHCJS__) && !defined(mingw32_HOST_OS) && MIN_VERSION_base(4,4,0) +#if !defined(__GHCJS__) && !defined(mingw32_HOST_OS) import Data.List (intersperse) import Data.Maybe (catMaybes) import Data.Monoid.Compat ((<>)) 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,8 +1,5 @@ {-# LANGUAGE CPP #-} - -#if MIN_VERSION_base(4,4,0) {-# OPTIONS_GHC -fno-warn-orphans #-} -#endif {-| Module: TextShow.GHC.Fingerprint Copyright: (C) 2014-2017 Ryan Scott @@ -12,13 +9,11 @@ Portability: GHC 'TextShow' instance for 'Fingerprint'. -Only provided if using @base-4.4.0.0@ or later. /Since: 2/ -} module TextShow.GHC.Fingerprint () where -#if MIN_VERSION_base(4,4,0) import Data.Monoid.Compat ((<>)) import Data.Semigroup (mtimesDefault) import Data.Text.Lazy.Builder (Builder, singleton) @@ -37,4 +32,3 @@ hex16 :: Word64 -> Builder hex16 i = let hex = showbHex i in mtimesDefault (max 0 $ 16 - lengthB hex) (singleton '0') <> hex -#endif 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 @@ -32,16 +32,6 @@ import TextShow.TH.Internal (deriveTextShow, deriveTextShow1, makeShowbPrec, makeLiftShowbPrec, makeLiftShowbPrec2) -#if !(MIN_VERSION_template_haskell(2,7,0)) -import Data.Monoid.Compat ((<>)) -import Data.Text.Lazy.Builder (singleton) - -import GHC.Exts (Char(C#), Double(D#), Float(F#), Int(I#), Word(W#)) -import GHC.Show (appPrec) - -import TextShow.Classes (showbParen) -#endif - -- | /Since: 2/ instance TextShow (U1 p) where showbPrec = liftShowbPrec undefined undefined @@ -94,7 +84,6 @@ -- | /Since: 2/ $(deriveTextShow1 ''(:.:)) -#if MIN_VERSION_template_haskell(2,7,0) -- | /Since: 2.1.2/ instance TextShow (UChar p) where showbPrec = $(makeShowbPrec 'UChar) @@ -124,57 +113,6 @@ showbPrec = $(makeShowbPrec 'UWord) -- | /Since: 2.1.2/ $(deriveTextShow1 'UWord) -#else --- | /Since: 2.1.2/ -instance TextShow (UChar p) where - showbPrec = liftShowbPrec undefined undefined --- | /Since: 2.1.2/ -instance TextShow1 UChar where - liftShowbPrec _ _ p (UChar c) = showbParen (p > appPrec) $ - "UChar " <> singleton '{' - <> "uChar# = " <> showb (C# c) - <> singleton '}' - --- | /Since: 2.1.2/ -instance TextShow (UDouble p) where - showbPrec = liftShowbPrec undefined undefined --- | /Since: 2.1.2/ -instance TextShow1 UDouble where - liftShowbPrec _ _ p (UDouble d) = showbParen (p > appPrec) $ - "UDouble " <> singleton '{' - <> "uDouble# = " <> showb (D# d) - <> singleton '}' - --- | /Since: 2.1.2/ -instance TextShow (UFloat p) where - showbPrec = liftShowbPrec undefined undefined --- | /Since: 2.1.2/ -instance TextShow1 UFloat where - liftShowbPrec _ _ p (UFloat f) = showbParen (p > appPrec) $ - "UFloat " <> singleton '{' - <> "uFloat# = " <> showb (F# f) - <> singleton '}' - --- | /Since: 2.1.2/ -instance TextShow (UInt p) where - showbPrec = liftShowbPrec undefined undefined --- | /Since: 2.1.2/ -instance TextShow1 UInt where - liftShowbPrec _ _ p (UInt i) = showbParen (p > appPrec) $ - "UInt " <> singleton '{' - <> "uInt# = " <> showb (I# i) - <> singleton '}' - --- | /Since: 2.1.2/ -instance TextShow (UWord p) where - showbPrec = liftShowbPrec undefined undefined --- | /Since: 2.1.2/ -instance TextShow1 UWord where - liftShowbPrec _ _ p (UWord w) = showbParen (p > appPrec) $ - "UWord " <> singleton '{' - <> "uWord# = " <> showb (W# w) - <> singleton '}' -#endif -- | /Since: 2/ $(deriveTextShow ''Fixity) 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 @@ -1,10 +1,8 @@ {-# LANGUAGE CPP #-} - -#if MIN_VERSION_base(4,5,0) {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-deprecations #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -#endif + {-| Module: TextShow.GHC.Stats Copyright: (C) 2014-2017 Ryan Scott @@ -14,13 +12,11 @@ Portability: GHC 'TextShow' instance for 'GCStats'. -Only provided if using @base-4.5.0.0@ or later. /Since: 2/ -} module TextShow.GHC.Stats () where -#if MIN_VERSION_base(4,5,0) import GHC.Stats (GCStats) import TextShow.Data.Integral () @@ -29,4 +25,3 @@ -- /Since: 2/ $(deriveTextShow ''GCStats) -#endif diff --git a/src/TextShow/Generic.hs b/src/TextShow/Generic.hs --- a/src/TextShow/Generic.hs +++ b/src/TextShow/Generic.hs @@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -15,10 +16,6 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE DeriveGeneric #-} -#endif - #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} @@ -97,9 +94,6 @@ import Data.Text.Lazy.Builder (Builder) import Generics.Deriving.Base -#if __GLASGOW_HASKELL__ < 702 -import qualified Generics.Deriving.TH as Generics (deriveAll) -#endif import GHC.Exts (Char(C#), Double(D#), Float(F#), Int(I#), Word(W#)) import GHC.Show (appPrec, appPrec1) @@ -273,13 +267,11 @@ data ConType = Rec | Tup | Pref | Inf String deriving ( Data , Eq + , Generic , Ord , Read , Show , Typeable -#if __GLASGOW_HASKELL__ >= 702 - , Generic -#endif #if __GLASGOW_HASKELL__ >= 800 , Lift #endif @@ -578,10 +570,6 @@ ------------------------------------------------------------------------------- $(deriveTextShow ''ConType) - -#if __GLASGOW_HASKELL__ < 702 -$(Generics.deriveAll ''ConType) -#endif #if __GLASGOW_HASKELL__ < 800 $(deriveLift ''ConType) 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,9 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE DeriveGeneric #-} -#endif - #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} @@ -37,11 +34,7 @@ import Data.Data (Data, Typeable) import Data.Ix (Ix) -#if __GLASGOW_HASKELL__ >= 702 import GHC.Generics (Generic) -#else -import qualified Generics.Deriving.TH as Generics -#endif import Language.Haskell.TH.Lift @@ -54,13 +47,11 @@ -- return @Text@? } deriving ( Data , Eq + , Generic , Ord , Read , Show , Typeable -#if __GLASGOW_HASKELL__ >= 702 - , Generic -#endif #if __GLASGOW_HASKELL__ >= 800 , Lift #endif @@ -78,14 +69,12 @@ , Data , Enum , Eq + , Generic , Ix , Ord , Read , Show , Typeable -#if __GLASGOW_HASKELL__ >= 702 - , Generic -#endif #if __GLASGOW_HASKELL__ >= 800 , Lift #endif @@ -98,11 +87,6 @@ defaultOptions = Options { genTextMethods = SometimesTextMethods } ------------------------------------------------------------------------------- - -#if __GLASGOW_HASKELL__ < 702 -$(Generics.deriveAll ''Options) -$(Generics.deriveAll ''GenTextMethods) -#endif #if __GLASGOW_HASKELL__ < 800 $(deriveLift ''Options) 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,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -19,11 +18,8 @@ import Data.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (Builder, fromString, singleton) -import GHC.IO.Encoding.Types (TextEncoding(textEncodingName)) -#if MIN_VERSION_base(4,4,0) import GHC.IO.Encoding.Failure (CodingFailureMode) -import GHC.IO.Encoding.Types (CodingProgress) -#endif +import GHC.IO.Encoding.Types (CodingProgress, TextEncoding(textEncodingName)) import GHC.IO.Handle (HandlePosn(..)) import GHC.IO.Handle.Types (Handle(..)) @@ -63,17 +59,10 @@ showb = fromString . textEncodingName {-# INLINE showb #-} -#if MIN_VERSION_base(4,4,0) --- | Only available with @base-4.4.0.0@ or later. --- --- /Since: 2/ +-- | /Since: 2/ $(deriveTextShow ''CodingProgress) --- | Only available with @base-4.4.0.0@ or later. --- --- /Since: 2/ +-- | /Since: 2/ $(deriveTextShow ''CodingFailureMode) -#endif - -- | /Since: 2/ $(deriveTextShow ''Newline) -- | /Since: 2/ 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 @@ -18,8 +18,6 @@ /Since: 2/ -} -#include "HsBaseConfig.h" - module TextShow.System.Posix.Types () where import System.Posix.Types @@ -29,159 +27,71 @@ import TextShow.Foreign.C.Types () import TextShow.Foreign.Ptr () -#if !(MIN_VERSION_base(4,5,0)) -import Data.Int -import Data.Text.Lazy.Builder (Builder) -import Data.Word - -import Unsafe.Coerce (unsafeCoerce) - -# include "HsBaseConfig.h" -#endif +#include "HsBaseConfig.h" -#if MIN_VERSION_base(4,5,0) -# if defined(HTYPE_DEV_T) +#if defined(HTYPE_DEV_T) -- | /Since: 2/ deriving instance TextShow CDev -# endif +#endif -# if defined(HTYPE_INO_T) +#if defined(HTYPE_INO_T) -- | /Since: 2/ deriving instance TextShow CIno -# endif +#endif -# if defined(HTYPE_MODE_T) +#if defined(HTYPE_MODE_T) -- | /Since: 2/ deriving instance TextShow CMode -# endif +#endif -# if defined(HTYPE_OFF_T) +#if defined(HTYPE_OFF_T) -- | /Since: 2/ deriving instance TextShow COff -# endif +#endif -# if defined(HTYPE_PID_T) +#if defined(HTYPE_PID_T) -- | /Since: 2/ deriving instance TextShow CPid -# endif +#endif -# if defined(HTYPE_SSIZE_T) +#if defined(HTYPE_SSIZE_T) -- | /Since: 2/ deriving instance TextShow CSsize -# endif +#endif -# if defined(HTYPE_GID_T) +#if defined(HTYPE_GID_T) -- | /Since: 2/ deriving instance TextShow CGid -# endif +#endif -# if defined(HTYPE_NLINK_T) +#if defined(HTYPE_NLINK_T) -- | /Since: 2/ deriving instance TextShow CNlink -# endif +#endif -# if defined(HTYPE_UID_T) +#if defined(HTYPE_UID_T) -- | /Since: 2/ deriving instance TextShow CUid -# endif +#endif -# if defined(HTYPE_CC_T) +#if defined(HTYPE_CC_T) -- | /Since: 2/ deriving instance TextShow CCc -# endif +#endif -# if defined(HTYPE_SPEED_T) +#if defined(HTYPE_SPEED_T) -- | /Since: 2/ deriving instance TextShow CSpeed -# endif +#endif -# if defined(HTYPE_TCFLAG_T) +#if defined(HTYPE_TCFLAG_T) -- | /Since: 2/ deriving instance TextShow CTcflag -# endif +#endif -# if defined(HTYPE_RLIM_T) +#if defined(HTYPE_RLIM_T) -- | /Since: 2/ deriving instance TextShow CRLim -# endif -#else -# if defined(HTYPE_DEV_T) --- | /Since: 2/ -instance TextShow CDev where - showb = unsafeCoerce (showb :: HTYPE_DEV_T -> Builder) -# endif - -# if defined(HTYPE_INO_T) --- | /Since: 2/ -instance TextShow CIno where - showb = unsafeCoerce (showb :: HTYPE_INO_T -> Builder) -# endif - -# if defined(HTYPE_MODE_T) --- | /Since: 2/ -instance TextShow CMode where - showb = unsafeCoerce (showb :: HTYPE_MODE_T -> Builder) -# endif - -# if defined(HTYPE_OFF_T) --- | /Since: 2/ -instance TextShow COff where - showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_OFF_T -> Builder) -# endif - -# if defined(HTYPE_PID_T) --- | /Since: 2/ -instance TextShow CPid where - showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_PID_T -> Builder) -# endif - -# if defined(HTYPE_SSIZE_T) --- | /Since: 2/ -instance TextShow CSsize where - showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_SSIZE_T -> Builder) -# endif - -# if defined(HTYPE_GID_T) --- | /Since: 2/ -instance TextShow CGid where - showb = unsafeCoerce (showb :: HTYPE_GID_T -> Builder) -# endif - -# if defined(HTYPE_NLINK_T) --- | /Since: 2/ -instance TextShow CNlink where - showb = unsafeCoerce (showb :: HTYPE_NLINK_T -> Builder) -# endif - -# if defined(HTYPE_UID_T) --- | /Since: 2/ -instance TextShow CUid where - showb = unsafeCoerce (showb :: HTYPE_UID_T -> Builder) -# endif - -# if defined(HTYPE_CC_T) --- | /Since: 2/ -instance TextShow CCc where - showb = unsafeCoerce (showb :: HTYPE_CC_T -> Builder) -# endif - -# if defined(HTYPE_SPEED_T) --- | /Since: 2/ -instance TextShow CSpeed where - showb = unsafeCoerce (showb :: HTYPE_SPEED_T -> Builder) -# endif - -# if defined(HTYPE_TCFLAG_T) --- | /Since: 2/ -instance TextShow CTcflag where - showb = unsafeCoerce (showb :: HTYPE_TCFLAG_T -> Builder) -# endif - -# if defined(HTYPE_RLIM_T) --- | /Since: 2/ -instance TextShow CRLim where - showb = unsafeCoerce (showb :: HTYPE_RLIM_T -> Builder) -# endif #endif #if MIN_VERSION_base(4,10,0) 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 @@ -55,15 +55,12 @@ , deriveTextShow2Options ) where -import Control.Monad (liftM, unless, when) -#if MIN_VERSION_template_haskell(2,11,0) -import Control.Monad ((<=<)) -#endif +import Control.Monad (unless, when) import Data.Foldable.Compat import Data.List.Compat -import qualified Data.List.NonEmpty as NE (drop, length, reverse, splitAt) +import qualified Data.List.NonEmpty as NE (reverse) import Data.List.NonEmpty (NonEmpty(..), (<|)) -import qualified Data.Map as Map (fromList, findWithDefault, keys, lookup, singleton) +import qualified Data.Map as Map (fromList, keys, lookup, singleton) import Data.Map (Map) import Data.Maybe import Data.Monoid.Compat ((<>)) @@ -81,6 +78,7 @@ import GHC.Prim (Char#, Double#, Float#, Int#, Word#) import GHC.Show (appPrec, appPrec1) +import Language.Haskell.TH.Datatype import Language.Haskell.TH.Lib import Language.Haskell.TH.Ppr hiding (appPrec) import Language.Haskell.TH.Syntax @@ -120,7 +118,6 @@ $('deriveTextShow' ''Box) -- instance TextShow a => TextShow (Box a) where ... @ -If you are using @template-haskell-2.7.0.0@ or later (i.e., GHC 7.4 or later), 'deriveTextShow' can also be used to derive 'TextShow' instances for data family instances (which requires the @-XTypeFamilies@ extension). To do so, pass the name of a data or newtype instance constructor (NOT a data family name!) to 'deriveTextShow'. @@ -459,21 +456,26 @@ -- | Derive a TextShow(1)(2) instance declaration (depending on the TextShowClass -- argument's value). deriveTextShowClass :: TextShowClass -> Options -> Name -> Q [Dec] -deriveTextShowClass tsClass opts name = withType name fromCons - where - fromCons :: Name -> Cxt -> [TyVarBndr] -> [Con] -> Maybe [Type] -> Q [Dec] - fromCons name' ctxt tvbs cons mbTys = (:[]) <$> do - (instanceCxt, instanceType) - <- buildTypeInstance tsClass name' ctxt tvbs mbTys - instanceD (return instanceCxt) - (return instanceType) - (showbPrecDecs tsClass opts cons) +deriveTextShowClass tsClass opts name = do + info <- reifyDatatype name + case info of + DatatypeInfo { datatypeContext = ctxt + , datatypeName = parentName + , datatypeVars = vars + , datatypeVariant = variant + , datatypeCons = cons + } -> do + (instanceCxt, instanceType) + <- buildTypeInstance tsClass parentName ctxt vars variant + (:[]) <$> instanceD (return instanceCxt) + (return instanceType) + (showbPrecDecs tsClass opts vars cons) -- | Generates a declaration defining the primary function corresponding to a -- particular class (showbPrec for TextShow, liftShowbPrec for TextShow1, and -- liftShowbPrec2 for TextShow2). -showbPrecDecs :: TextShowClass -> Options -> [Con] -> [Q Dec] -showbPrecDecs tsClass opts cons = +showbPrecDecs :: TextShowClass -> Options -> [Type] -> [ConstructorInfo] -> [Q Dec] +showbPrecDecs tsClass opts vars cons = [genMethod ShowbPrec (showbPrecName tsClass)] ++ if tsClass == TextShow && shouldGenTextMethods then [genMethod ShowtPrec 'showtPrec, genMethod ShowtlPrec 'showtlPrec] @@ -489,7 +491,7 @@ genMethod method methodName = funD methodName [ clause [] - (normalB $ makeTextShowForCons tsClass method cons) + (normalB $ makeTextShowForCons tsClass method vars cons) [] ] @@ -497,28 +499,36 @@ -- | Generates a lambda expression which behaves like showbPrec (for TextShow), -- liftShowbPrec (for TextShow1), or liftShowbPrec2 (for TextShow2). makeShowbPrecClass :: TextShowClass -> TextShowFun -> Name -> Q Exp -makeShowbPrecClass tsClass tsFun name = withType name fromCons - where - fromCons :: Name -> Cxt -> [TyVarBndr] -> [Con] -> Maybe [Type] -> Q Exp - fromCons name' ctxt tvbs cons mbTys = - -- We force buildTypeInstance here since it performs some checks for whether - -- or not the provided datatype can actually have showbPrec/liftShowbPrec/etc. - -- implemented for it, and produces errors if it can't. - buildTypeInstance tsClass name' ctxt tvbs mbTys - `seq` makeTextShowForCons tsClass tsFun cons +makeShowbPrecClass tsClass tsFun name = do + info <- reifyDatatype name + case info of + DatatypeInfo { datatypeContext = ctxt + , datatypeName = parentName + , datatypeVars = vars + , datatypeVariant = variant + , datatypeCons = cons + } -> + -- We force buildTypeInstance here since it performs some checks for whether + -- or not the provided datatype can actually have showbPrec/liftShowbPrec/etc. + -- implemented for it, and produces errors if it can't. + buildTypeInstance tsClass parentName ctxt vars variant + `seq` makeTextShowForCons tsClass tsFun vars cons -- | Generates a lambda expression for showbPrec/liftShowbPrec/etc. for the -- given constructors. All constructors must be from the same type. -makeTextShowForCons :: TextShowClass -> TextShowFun -> [Con] -> Q Exp -makeTextShowForCons _ _ [] = error "Must have at least one data constructor" -makeTextShowForCons tsClass tsFun cons = do +makeTextShowForCons :: TextShowClass -> TextShowFun -> [Type] -> [ConstructorInfo] + -> Q Exp +makeTextShowForCons _ _ _ [] = error "Must have at least one data constructor" +makeTextShowForCons tsClass tsFun vars cons = do p <- newName "p" value <- newName "value" sps <- newNameList "sp" $ fromEnum tsClass sls <- newNameList "sl" $ fromEnum tsClass - let spls = zip sps sls - spsAndSls = interleave sps sls - matches <- concatMapM (makeTextShowForCon p tsClass tsFun spls) cons + let spls = zip sps sls + spsAndSls = interleave sps sls + lastTyVars = map varTToName $ drop (length vars - fromEnum tsClass) vars + splMap = Map.fromList $ zip lastTyVars spls + matches <- mapM (makeTextShowForCon p tsClass tsFun splMap) cons lamE (map varP $ spsAndSls ++ [p, value]) . appsE $ [ varE $ showPrecConstName tsClass tsFun @@ -531,71 +541,76 @@ makeTextShowForCon :: Name -> TextShowClass -> TextShowFun - -> [(Name, Name)] - -> Con - -> Q [Match] -makeTextShowForCon _ _ tsFun _ (NormalC conName []) = do - m <- match - (conP conName []) - (normalB $ varE (fromStringName tsFun) `appE` stringE (parenInfixConName conName "")) - [] - return [m] -makeTextShowForCon p tsClass tsFun spls (NormalC conName [_]) = do - ([argTy], tvMap) <- reifyConTys tsClass spls conName + -> TyVarMap + -> ConstructorInfo + -> Q Match +makeTextShowForCon _ _ tsFun _ + (ConstructorInfo { constructorName = conName, constructorFields = [] }) = + match + (conP conName []) + (normalB $ varE (fromStringName tsFun) `appE` stringE (parenInfixConName conName "")) + [] +makeTextShowForCon p tsClass tsFun tvMap + (ConstructorInfo { constructorName = conName + , constructorVariant = NormalConstructor + , constructorFields = [argTy] }) = do + argTy' <- resolveTypeSynonyms argTy arg <- newName "arg" - let showArg = makeTextShowForArg appPrec1 tsClass tsFun conName tvMap argTy arg + let showArg = makeTextShowForArg appPrec1 tsClass tsFun conName tvMap argTy' arg namedArg = infixApp (varE (fromStringName tsFun) `appE` stringE (parenInfixConName conName " ")) [| (<>) |] showArg - m <- match - (conP conName [varP arg]) - (normalB $ varE (showParenName tsFun) - `appE` infixApp (varE p) [| (>) |] (integerE appPrec) - `appE` namedArg) - [] - return [m] -makeTextShowForCon p tsClass tsFun spls (NormalC conName _) = do - (argTys, tvMap) <- reifyConTys tsClass spls conName - args <- newNameList "arg" $ length argTys + match + (conP conName [varP arg]) + (normalB $ varE (showParenName tsFun) + `appE` infixApp (varE p) [| (>) |] (integerE appPrec) + `appE` namedArg) + [] +makeTextShowForCon p tsClass tsFun tvMap + (ConstructorInfo { constructorName = conName + , constructorVariant = NormalConstructor + , constructorFields = argTys }) = do + argTys' <- mapM resolveTypeSynonyms argTys + args <- newNameList "arg" $ length argTys' - m <- if isNonUnitTuple conName - then do - let showArgs = zipWith (makeTextShowForArg 0 tsClass tsFun conName tvMap) argTys args - parenCommaArgs = (varE (singletonName tsFun) `appE` charE '(') - : intersperse (varE (singletonName tsFun) `appE` charE ',') showArgs - mappendArgs = foldr' (`infixApp` [| (<>) |]) - (varE (singletonName tsFun) `appE` charE ')') - parenCommaArgs + if isNonUnitTuple conName + then do + let showArgs = zipWith (makeTextShowForArg 0 tsClass tsFun conName tvMap) argTys' args + parenCommaArgs = (varE (singletonName tsFun) `appE` charE '(') + : intersperse (varE (singletonName tsFun) `appE` charE ',') showArgs + mappendArgs = foldr' (`infixApp` [| (<>) |]) + (varE (singletonName tsFun) `appE` charE ')') + parenCommaArgs - match (conP conName $ map varP args) - (normalB mappendArgs) - [] - else do - let showArgs = zipWith (makeTextShowForArg appPrec1 tsClass tsFun conName tvMap) argTys args - mappendArgs = foldr1 (\v q -> infixApp v - [| (<>) |] - (infixApp (varE $ showSpaceName tsFun) - [| (<>) |] - q)) showArgs - namedArgs = infixApp (varE (fromStringName tsFun) `appE` stringE (parenInfixConName conName " ")) - [| (<>) |] - mappendArgs + match (conP conName $ map varP args) + (normalB mappendArgs) + [] + else do + let showArgs = zipWith (makeTextShowForArg appPrec1 tsClass tsFun conName tvMap) argTys' args + mappendArgs = foldr1 (\v q -> infixApp v + [| (<>) |] + (infixApp (varE $ showSpaceName tsFun) + [| (<>) |] + q)) showArgs + namedArgs = infixApp (varE (fromStringName tsFun) `appE` stringE (parenInfixConName conName " ")) + [| (<>) |] + mappendArgs - match (conP conName $ map varP args) - (normalB $ varE (showParenName tsFun) - `appE` infixApp (varE p) [| (>) |] (integerE appPrec) - `appE` namedArgs) - [] - return [m] -makeTextShowForCon p tsClass tsFun spls (RecC conName []) = - makeTextShowForCon p tsClass tsFun spls $ NormalC conName [] -makeTextShowForCon p tsClass tsFun spls (RecC conName ts) = do - (argTys, tvMap) <- reifyConTys tsClass spls conName - args <- newNameList "arg" $ length argTys + match (conP conName $ map varP args) + (normalB $ varE (showParenName tsFun) + `appE` infixApp (varE p) [| (>) |] (integerE appPrec) + `appE` namedArgs) + [] +makeTextShowForCon p tsClass tsFun tvMap + (ConstructorInfo { constructorName = conName + , constructorVariant = RecordConstructor argNames + , constructorFields = argTys }) = do + argTys' <- mapM resolveTypeSynonyms argTys + args <- newNameList "arg" $ length argTys' - let showArgs = concatMap (\((argName, _, _), argTy, arg) + let showArgs = concatMap (\(argName, argTy, arg) -> let argNameBase = nameBase argName infixRec = showParen (isSymVar argNameBase) (showString argNameBase) "" @@ -604,7 +619,7 @@ , varE (showCommaSpaceName tsFun) ] ) - (zip3 ts argTys args) + (zip3 argNames argTys' args) braceCommaArgs = (varE (singletonName tsFun) `appE` charE '{') : take (length showArgs - 1) showArgs mappendArgs = foldr' (`infixApp` [| (<>) |]) (varE (singletonName tsFun) `appE` charE '}') @@ -613,65 +628,37 @@ [| (<>) |] mappendArgs - m <- match - (conP conName $ map varP args) - (normalB $ varE (showParenName tsFun) - `appE` infixApp (varE p) [| (>) |] (integerE appPrec) - `appE` namedArgs) - [] - return [m] -makeTextShowForCon p tsClass tsFun spls (InfixC _ conName _) = do - ([alTy, arTy], tvMap) <- reifyConTys tsClass spls conName - al <- newName "argL" - ar <- newName "argR" - info <- reify conName - -#if MIN_VERSION_template_haskell(2,11,0) - conPrec <- case info of - DataConI{} -> do - fi <- fromMaybe defaultFixity <$> reifyFixity conName - case fi of - Fixity prec _ -> return prec -#else - let conPrec = case info of - DataConI _ _ _ (Fixity prec _) -> prec -#endif - _ -> error $ "TextShow.TH.makeTextShowForCon: Unsupported type: " ++ show info - - let opName = nameBase conName + match + (conP conName $ map varP args) + (normalB $ varE (showParenName tsFun) + `appE` infixApp (varE p) [| (>) |] (integerE appPrec) + `appE` namedArgs) + [] +makeTextShowForCon p tsClass tsFun tvMap + (ConstructorInfo { constructorName = conName + , constructorVariant = InfixConstructor + , constructorFields = argTys }) = do + [alTy, arTy] <- mapM resolveTypeSynonyms argTys + al <- newName "argL" + ar <- newName "argR" + fi <- fromMaybe defaultFixity <$> reifyFixityCompat conName + let conPrec = case fi of Fixity prec _ -> prec + opName = nameBase conName infixOpE = appE (varE $ fromStringName tsFun) . stringE $ if isInfixDataCon opName then " " ++ opName ++ " " else " `" ++ opName ++ "` " - m <- match - (infixP (varP al) conName (varP ar)) - (normalB $ (varE (showParenName tsFun) `appE` infixApp (varE p) [| (>) |] (integerE conPrec)) - `appE` (infixApp (makeTextShowForArg (conPrec + 1) tsClass tsFun conName tvMap alTy al) - [| (<>) |] - (infixApp infixOpE - [| (<>) |] - (makeTextShowForArg (conPrec + 1) tsClass tsFun conName tvMap arTy ar))) - ) - [] - return [m] -makeTextShowForCon p tsClass tsFun spls (ForallC _ _ con) = - makeTextShowForCon p tsClass tsFun spls con -#if MIN_VERSION_template_haskell(2,11,0) -makeTextShowForCon p tsClass tsFun spls (GadtC conNames ts _) = - let con :: Name -> Q Con - con conName = do - mbFi <- reifyFixity conName - return $ if isInfixDataCon (nameBase conName) - && length ts == 2 - && isJust mbFi - then let [t1, t2] = ts in InfixC t1 conName t2 - else NormalC conName ts - - in concatMapM (makeTextShowForCon p tsClass tsFun spls <=< con) conNames -makeTextShowForCon p tsClass tsFun spls (RecGadtC conNames ts _) = - concatMapM (makeTextShowForCon p tsClass tsFun spls . flip RecC ts) conNames -#endif + match + (infixP (varP al) conName (varP ar)) + (normalB $ (varE (showParenName tsFun) `appE` infixApp (varE p) [| (>) |] (integerE conPrec)) + `appE` (infixApp (makeTextShowForArg (conPrec + 1) tsClass tsFun conName tvMap alTy al) + [| (<>) |] + (infixApp infixOpE + [| (<>) |] + (makeTextShowForArg (conPrec + 1) tsClass tsFun conName tvMap arTy ar))) + ) + [] -- | Generates a lambda expression for howbPrec/liftShowbPrec/etc. for an -- argument of a constructor. @@ -771,202 +758,27 @@ -- Template Haskell reifying and AST manipulation ------------------------------------------------------------------------------- --- | Extracts a plain type constructor's information. --- | Boilerplate for top level splices. --- --- The given Name must meet one of two criteria: --- --- 1. It must be the name of a type constructor of a plain data type or newtype. --- 2. It must be the name of a data family instance or newtype instance constructor. --- --- Any other value will result in an exception. -withType :: Name - -> (Name -> Cxt -> [TyVarBndr] -> [Con] -> Maybe [Type] -> Q a) - -> Q a -withType name f = do - info <- reify name - case info of - TyConI dec -> - case dec of - DataD ctxt _ tvbs -#if MIN_VERSION_template_haskell(2,11,0) - _ -#endif - cons _ -> f name ctxt tvbs cons Nothing - NewtypeD ctxt _ tvbs -#if MIN_VERSION_template_haskell(2,11,0) - _ -#endif - con _ -> f name ctxt tvbs [con] Nothing - _ -> error $ ns ++ "Unsupported type: " ++ show dec -#if MIN_VERSION_template_haskell(2,7,0) -# if MIN_VERSION_template_haskell(2,11,0) - DataConI _ _ parentName -> do -# else - DataConI _ _ parentName _ -> do -# endif - parentInfo <- reify parentName - case parentInfo of -# if MIN_VERSION_template_haskell(2,11,0) - FamilyI (DataFamilyD _ tvbs _) decs -> -# else - FamilyI (FamilyD DataFam _ tvbs _) decs -> -# endif - let instDec = flip find decs $ \dec -> case dec of - DataInstD _ _ _ -# if MIN_VERSION_template_haskell(2,11,0) - _ -# endif - cons _ -> any ((name ==) . constructorName) cons - NewtypeInstD _ _ _ -# if MIN_VERSION_template_haskell(2,11,0) - _ -# endif - con _ -> name == constructorName con - _ -> error $ ns ++ "Must be a data or newtype instance." - in case instDec of - Just (DataInstD ctxt _ instTys -# if MIN_VERSION_template_haskell(2,11,0) - _ -# endif - cons _) - -> f parentName ctxt tvbs cons $ Just instTys - Just (NewtypeInstD ctxt _ instTys -# if MIN_VERSION_template_haskell(2,11,0) - _ -# endif - con _) - -> f parentName ctxt tvbs [con] $ Just instTys - _ -> error $ ns ++ - "Could not find data or newtype instance constructor." - _ -> error $ ns ++ "Data constructor " ++ show name ++ - " is not from a data family instance constructor." -# if MIN_VERSION_template_haskell(2,11,0) - FamilyI DataFamilyD{} _ -> -# else - FamilyI (FamilyD DataFam _ _ _) _ -> -# endif - error $ ns ++ - "Cannot use a data family name. Use a data family instance constructor instead." - _ -> error $ ns ++ "The name must be of a plain data type constructor, " - ++ "or a data family instance constructor." -#else - DataConI{} -> dataConIError - _ -> error $ ns ++ "The name must be of a plain type constructor." -#endif - where - ns :: String - ns = "TextShow.TH.withType: " - --- | Deduces the instance context and head for an instance. +-- For the given Types, generate an instance context and head. Coming up with +-- the instance type isn't as simple as dropping the last types, as you need to +-- be wary of kinds being instantiated with *. +-- See Note [Type inference in derived instances] buildTypeInstance :: TextShowClass -- ^ TextShow, TextShow1, or TextShow2 -> Name -- ^ The type constructor or data family name -> Cxt -- ^ The datatype context - -> [TyVarBndr] - -- ^ The type variables from the data type/data family declaration - -> Maybe [Type] - -- ^ 'Just' the types used to instantiate a data family instance, - -- or 'Nothing' if it's a plain data type + -> [Type] + -- ^ The types to instantiate the instance with + -> DatatypeVariant + -- ^ Are we dealing with a data family instance or not -> Q (Cxt, Type) --- Plain data type/newtype case -buildTypeInstance tsClass tyConName dataCxt tvbs Nothing = - let varTys :: [Type] - varTys = map tvbToType tvbs - in buildTypeInstanceFromTys tsClass tyConName dataCxt varTys False --- Data family instance case --- --- The CPP is present to work around a couple of annoying old GHC bugs. --- See Note [Polykinded data families in Template Haskell] -buildTypeInstance tsClass parentName dataCxt tvbs (Just instTysAndKinds) = do -#if !(MIN_VERSION_template_haskell(2,8,0)) || MIN_VERSION_template_haskell(2,10,0) - let instTys :: [Type] - instTys = zipWith stealKindForType tvbs instTysAndKinds -#else - let kindVarNames :: [Name] - kindVarNames = nub $ concatMap (tyVarNamesOfType . tvbKind) tvbs - - numKindVars :: Int - numKindVars = length kindVarNames - - givenKinds, givenKinds' :: [Kind] - givenTys :: [Type] - (givenKinds, givenTys) = splitAt numKindVars instTysAndKinds - givenKinds' = map sanitizeStars givenKinds - - -- A GHC 7.6-specific bug requires us to replace all occurrences of - -- (ConT GHC.Prim.*) with StarT, or else Template Haskell will reject it. - -- Luckily, (ConT GHC.Prim.*) only seems to occur in this one spot. - sanitizeStars :: Kind -> Kind - sanitizeStars = go - where - go :: Kind -> Kind - go (AppT t1 t2) = AppT (go t1) (go t2) - go (SigT t k) = SigT (go t) (go k) - go (ConT n) | n == starKindName = StarT - go t = t - - -- It's quite awkward to import * from GHC.Prim, so we'll just - -- hack our way around it. - starKindName :: Name - starKindName = mkNameG_tc "ghc-prim" "GHC.Prim" "*" - - -- If we run this code with GHC 7.8, we might have to generate extra type - -- variables to compensate for any type variables that Template Haskell - -- eta-reduced away. - -- See Note [Polykinded data families in Template Haskell] - xTypeNames <- newNameList "tExtra" (length tvbs - length givenTys) - - let xTys :: [Type] - xTys = map VarT xTypeNames - -- ^ Because these type variables were eta-reduced away, we can only - -- determine their kind by using stealKindForType. Therefore, we mark - -- them as VarT to ensure they will be given an explicit kind annotation - -- (and so the kind inference machinery has the right information). - - substNamesWithKinds :: [(Name, Kind)] -> Type -> Type - substNamesWithKinds nks t = foldr' (uncurry substNameWithKind) t nks - - -- The types from the data family instance might not have explicit kind - -- annotations, which the kind machinery needs to work correctly. To - -- compensate, we use stealKindForType to explicitly annotate any - -- types without kind annotations. - instTys :: [Type] - instTys = map (substNamesWithKinds (zip kindVarNames givenKinds')) - -- ^ Note that due to a GHC 7.8-specific bug - -- (see Note [Polykinded data families in Template Haskell]), - -- there may be more kind variable names than there are kinds - -- to substitute. But this is OK! If a kind is eta-reduced, it - -- means that is was not instantiated to something more specific, - -- so we need not substitute it. Using stealKindForType will - -- grab the correct kind. - $ zipWith stealKindForType tvbs (givenTys ++ xTys) -#endif - buildTypeInstanceFromTys tsClass parentName dataCxt instTys True - --- For the given Types, generate an instance context and head. Coming up with --- the instance type isn't as simple as dropping the last types, as you need to --- be wary of kinds being instantiated with *. --- See Note [Type inference in derived instances] -buildTypeInstanceFromTys :: TextShowClass - -- ^ TextShow, TextShow1, or TextShow2 - -> Name - -- ^ The type constructor or data family name - -> Cxt - -- ^ The datatype context - -> [Type] - -- ^ The types to instantiate the instance with - -> Bool - -- ^ True if it's a data family, False otherwise - -> Q (Cxt, Type) -buildTypeInstanceFromTys tsClass tyConName dataCxt varTysOrig isDataFamily = do +buildTypeInstance tsClass tyConName dataCxt varTysOrig variant = do -- Make sure to expand through type/kind synonyms! Otherwise, the -- eta-reduction check might get tripped up over type variables in a -- synonym that are actually dropped. -- (See GHC Trac #11416 for a scenario where this actually happened.) - varTysExp <- mapM expandSyn varTysOrig + varTysExp <- mapM resolveTypeSynonyms varTysOrig let remainingLength :: Int remainingLength = length varTysOrig - fromEnum tsClass @@ -996,7 +808,7 @@ -- All of the type variables mentioned in the dropped types -- (post-synonym expansion) droppedTyVarNames :: [Name] - droppedTyVarNames = concatMap tyVarNamesOfType droppedTysExpSubst + droppedTyVarNames = freeVariables droppedTysExpSubst -- If any of the dropped types were polykinded, ensure that they are of kind * -- after substituting * for the dropped kind variables. If not, throw an error. @@ -1037,6 +849,13 @@ map (substNamesWithKindStar (union droppedKindVarNames kvNames')) $ take remainingLength varTysOrig + isDataFamily :: Bool + isDataFamily = case variant of + Datatype -> False + Newtype -> False + DataInstance -> True + NewtypeInstance -> True + remainingTysOrigSubst' :: [Type] -- See Note [Kind signatures in derived instances] for an explanation -- of the isDataFamily check. @@ -1084,55 +903,6 @@ tName = varTToName t {- -Note [Polykinded data families in Template Haskell] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -In order to come up with the correct instance context and head for an instance, e.g., - - instance C a => C (Data a) where ... - -We need to know the exact types and kinds used to instantiate the instance. For -plain old datatypes, this is simple: every type must be a type variable, and -Template Haskell reliably tells us the type variables and their kinds. - -Doing the same for data families proves to be much harder for three reasons: - -1. On any version of Template Haskell, it may not tell you what an instantiated - type's kind is. For instance, in the following data family instance: - - data family Fam (f :: * -> *) (a :: *) - data instance Fam f a - - Then if we use TH's reify function, it would tell us the TyVarBndrs of the - data family declaration are: - - [KindedTV f (AppT (AppT ArrowT StarT) StarT),KindedTV a StarT] - - and the instantiated types of the data family instance are: - - [VarT f1,VarT a1] - - We can't just pass [VarT f1,VarT a1] to buildTypeInstanceFromTys, since we - have no way of knowing their kinds. Luckily, the TyVarBndrs tell us what the - kind is in case an instantiated type isn't a SigT, so we use the stealKindForType - function to ensure all of the instantiated types are SigTs before passing them - to buildTypeInstanceFromTys. -2. On GHC 7.6 and 7.8, a bug is present in which Template Haskell lists all of - the specified kinds of a data family instance efore any of the instantiated - types. Fortunately, this is easy to deal with: you simply count the number of - distinct kind variables in the data family declaration, take that many elements - from the front of the Types list of the data family instance, substitute the - kind variables with their respective instantiated kinds (which you took earlier), - and proceed as normal. -3. On GHC 7.8, an even uglier bug is present (GHC Trac #9692) in which Template - Haskell might not even list all of the Types of a data family instance, since - they are eta-reduced away! And yes, kinds can be eta-reduced too. - - The simplest workaround is to count how many instantiated types are missing from - the list and generate extra type variables to use in their place. Luckily, we - needn't worry much if its kind was eta-reduced away, since using stealKindForType - will get it back. - Note [Kind signatures in derived instances] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1267,89 +1037,19 @@ n :: Int n = fromEnum tsClass -#if !(MIN_VERSION_template_haskell(2,7,0)) --- | Template Haskell didn't list all of a data family's instances upon reification --- until template-haskell-2.7.0.0, which is necessary for a derived TextShow(1)(2) --- instance to work. -dataConIError :: a -dataConIError = error - . showString "Cannot use a data constructor." - . showString "\n\t(Note: if you are trying to derive TextShow for a" - . showString "\n\ttype family, use GHC >= 7.4 instead.)" - $ "" -#endif - ------------------------------------------------------------------------------- -- Expanding type synonyms ------------------------------------------------------------------------------- --- | Expands all type synonyms in a type. Written by Dan Rosén in the --- @genifunctors@ package (licensed under BSD3). -expandSyn :: Type -> Q Type -expandSyn (ForallT tvs ctx t) = fmap (ForallT tvs ctx) $ expandSyn t -expandSyn t@AppT{} = expandSynApp t [] -expandSyn t@ConT{} = expandSynApp t [] -expandSyn (SigT t k) = do t' <- expandSyn t - k' <- expandSynKind k - return (SigT t' k') -expandSyn t = return t - -expandSynKind :: Kind -> Q Kind -#if MIN_VERSION_template_haskell(2,8,0) -expandSynKind = expandSyn -#else -expandSynKind = return -- There are no kind synonyms to deal with -#endif - -expandSynApp :: Type -> [Type] -> Q Type -expandSynApp (AppT t1 t2) ts = do - t2' <- expandSyn t2 - expandSynApp t1 (t2':ts) -expandSynApp (ConT n) ts | nameBase n == "[]" = return $ foldl' AppT ListT ts -expandSynApp t@(ConT n) ts = do - info <- reify n - case info of - TyConI (TySynD _ tvs rhs) -> - let (ts', ts'') = splitAt (length tvs) ts - subs = mkSubst tvs ts' - rhs' = substType subs rhs - in expandSynApp rhs' ts'' - _ -> return $ foldl' AppT t ts -expandSynApp t ts = do - t' <- expandSyn t - return $ foldl' AppT t' ts - -type TypeSubst = Map Name Type -type KindSubst = Map Name Kind - -mkSubst :: [TyVarBndr] -> [Type] -> TypeSubst -mkSubst vs ts = - let vs' = map un vs - un (PlainTV v) = v - un (KindedTV v _) = v - in Map.fromList $ zip vs' ts - -substType :: TypeSubst -> Type -> Type -substType subs (ForallT v c t) = ForallT v c $ substType subs t -substType subs t@(VarT n) = Map.findWithDefault t n subs -substType subs (AppT t1 t2) = AppT (substType subs t1) (substType subs t2) -substType subs (SigT t k) = SigT (substType subs t) -#if MIN_VERSION_template_haskell(2,8,0) - (substType subs k) -#else - k -#endif -substType _ t = t - -substKind :: KindSubst -> Type -> Type +applySubstitutionKind :: Map Name Kind -> Type -> Type #if MIN_VERSION_template_haskell(2,8,0) -substKind = substType +applySubstitutionKind = applySubstitution #else -substKind _ = id -- There are no kind variables! +applySubstitutionKind _ t = t #endif substNameWithKind :: Name -> Kind -> Type -> Type -substNameWithKind n k = substKind (Map.singleton n k) +substNameWithKind n k = applySubstitutionKind (Map.singleton n k) substNamesWithKindStar :: [Name] -> Type -> Type substNamesWithKindStar ns t = foldr' (flip substNameWithKind starK) t ns @@ -1530,27 +1230,6 @@ newNameList :: String -> Int -> Q [Name] newNameList prefix n = mapM (newName . (prefix ++) . show) [1..n] --- | Gets all of the type/kind variable names mentioned somewhere in a Type. -tyVarNamesOfType :: Type -> [Name] -tyVarNamesOfType = go - where - go :: Type -> [Name] - go (AppT t1 t2) = go t1 ++ go t2 - go (SigT t _k) = go t -#if MIN_VERSION_template_haskell(2,8,0) - ++ go _k -#endif - go (VarT n) = [n] - go _ = [] - --- | Gets all of the type/kind variable names mentioned somewhere in a Kind. -tyVarNamesOfKind :: Kind -> [Name] -#if MIN_VERSION_template_haskell(2,8,0) -tyVarNamesOfKind = tyVarNamesOfType -#else -tyVarNamesOfKind _ = [] -- There are no kind variables -#endif - -- | @hasKindVarChain n kind@ Checks if @kind@ is of the form -- k_0 -> k_1 -> ... -> k_(n-1), where k0, k1, ..., and k_(n-1) can be * or -- kind variables. @@ -1558,7 +1237,7 @@ hasKindVarChain kindArrows t = let uk = uncurryKind (tyKind t) in if (length uk - 1 == kindArrows) && all isStarOrVar uk - then Just (concatMap tyVarNamesOfKind uk) + then Just (concatMap freeVariables uk) else Nothing -- | If a Type is a SigT, returns its kind signature. Otherwise, return *. @@ -1566,15 +1245,6 @@ tyKind (SigT _ k) = k tyKind _ = starK --- | If a VarT is missing an explicit kind signature, steal it from a TyVarBndr. -stealKindForType :: TyVarBndr -> Type -> Type -stealKindForType tvb t@VarT{} = SigT t (tvbKind tvb) -stealKindForType _ t = t - --- | Monadic version of concatMap -concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b] -concatMapM f xs = liftM concat (mapM f xs) - -- | A mapping of type variable Names to their show function Names. For example, in a -- TextShow2 declaration, a TyVarMap might look like (a ~> sp1, b ~> sp2), where -- a and b are the last two type variables of the datatype, and sp1 and sp2 are the two @@ -1592,16 +1262,6 @@ let conNameBase = nameBase conName in showParen (isInfixDataCon conNameBase) $ showString conNameBase --- | Extracts the kind from a TyVarBndr. -tvbKind :: TyVarBndr -> Kind -tvbKind (PlainTV _) = starK -tvbKind (KindedTV _ k) = k - --- | Convert a TyVarBndr to a Type. -tvbToType :: TyVarBndr -> Type -tvbToType (PlainTV n) = VarT n -tvbToType (KindedTV n k) = SigT (VarT n) k - -- | Applies a typeclass constraint to a type. applyClass :: Name -> Name -> Pred #if MIN_VERSION_template_haskell(2,10,0) @@ -1656,10 +1316,8 @@ return $ case info of #if MIN_VERSION_template_haskell(2,11,0) FamilyI OpenTypeFamilyD{} _ -> True -#elif MIN_VERSION_template_haskell(2,7,0) - FamilyI (FamilyD TypeFam _ _ _) _ -> True #else - TyConI (FamilyD TypeFam _ _ _) -> True + FamilyI (FamilyD TypeFam _ _ _) _ -> True #endif #if MIN_VERSION_template_haskell(2,9,0) FamilyI ClosedTypeFamilyD{} _ -> True @@ -1760,77 +1418,15 @@ where go :: Kind -> Int -> Kind go k !0 = k -#if MIN_VERSION_template_haskell(2,8,0) - go k !n = go (AppT (AppT ArrowT StarT) k) (n - 1) -#else - go k !n = go (ArrowK StarK k) (n - 1) -#endif - -#if MIN_VERSION_template_haskell(2,7,0) --- | Extracts the name of a constructor. -constructorName :: Con -> Name -constructorName (NormalC name _ ) = name -constructorName (RecC name _ ) = name -constructorName (InfixC _ name _ ) = name -constructorName (ForallC _ _ con) = constructorName con -# if MIN_VERSION_template_haskell(2,11,0) -constructorName (GadtC names _ _) = head names -constructorName (RecGadtC names _ _) = head names -# endif -#endif + go k !n = go (arrowKCompat starK k) (n - 1) -isNullaryCon :: Con -> Bool -isNullaryCon (NormalC _ []) = True -isNullaryCon (RecC _ []) = True -isNullaryCon InfixC{} = False -isNullaryCon (ForallC _ _ con) = isNullaryCon con -#if MIN_VERSION_template_haskell(2,11,0) -isNullaryCon (GadtC _ [] _) = True -isNullaryCon (RecGadtC _ [] _) = True -#endif -isNullaryCon _ = False +isNullaryCon :: ConstructorInfo -> Bool +isNullaryCon (ConstructorInfo { constructorFields = [] }) = True +isNullaryCon _ = False interleave :: [a] -> [a] -> [a] interleave (a1:a1s) (a2:a2s) = a1:a2:interleave a1s a2s interleave _ _ = [] - --- Determines the types of a constructor's arguments as well as the last type --- parameters (mapped to their show functions), expanding through any type synonyms. --- The type parameters are determined on a constructor-by-constructor basis since --- they may be refined to be particular types in a GADT. -reifyConTys :: TextShowClass - -> [(Name, Name)] - -> Name - -> Q ([Type], TyVarMap) -reifyConTys tsClass spls conName = do - info <- reify conName - uncTy <- case info of - DataConI _ ty _ -#if !(MIN_VERSION_template_haskell(2,11,0)) - _ -#endif - -> fmap uncurryTy (expandSyn ty) - _ -> error "Must be a data constructor" - let (argTys, [resTy]) = NE.splitAt (length uncTy - 1) uncTy - unapResTy = unapplyTy resTy - -- If one of the last type variables is refined to a particular type - -- (i.e., not truly polymorphic), we mark it with Nothing and filter - -- it out later, since we only apply show functions to arguments of - -- a type that it (1) one of the last type variables, and (2) - -- of a truly polymorphic type. - mbTvNames = map varTToName_maybe $ - NE.drop (NE.length unapResTy - fromEnum tsClass) unapResTy - -- We use Map.fromList to ensure that if there are any duplicate type - -- variables (as can happen in a GADT), the rightmost type variable gets - -- associated with the show function. - -- - -- See Note [Matching functions with GADT type variables] - tvMap = Map.fromList - . catMaybes -- Drop refined types - $ zipWith (\mbTvName sp -> - fmap (\tvName -> (tvName, sp)) mbTvName) - mbTvNames spls - return (argTys, tvMap) {- Note [Matching functions with GADT type variables] 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,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} @@ -6,10 +7,6 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE DeriveGeneric #-} -#endif - #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} @@ -62,15 +59,13 @@ import Test.QuickCheck (Arbitrary(..)) -#if MIN_VERSION_template_haskell(2,7,0) import Text.Show.Deriving (deriveShow1) -import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) - -# if defined(NEW_FUNCTOR_CLASSES) +#if defined(NEW_FUNCTOR_CLASSES) import Text.Show.Deriving (deriveShow2) -# endif #endif +import TextShow.TH (deriveTextShow, deriveTextShow1, deriveTextShow2) + ------------------------------------------------------------------------------- data family NotAllShow (w :: *) (x :: *) (y :: *) (z :: *) :: * @@ -90,26 +85,24 @@ instance (Arbitrary b, Arbitrary c, Arbitrary d) => Arbitrary (NotAllShow Int b c d) where arbitrary = genericArbitrary -#if MIN_VERSION_template_haskell(2,7,0) -# if !defined(NEW_FUNCTOR_CLASSES) +#if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 'NASShow1) -# else +#else $(deriveShow1 'NASShow1) $(deriveShow2 'NASShow2) -# endif +#endif $(deriveTextShow 'NASShow1) $(deriveTextShow1 'NASShow2) $(deriveTextShow2 'NASShow1) -# if !defined(__LANGUAGE_DERIVE_GENERIC1__) +#if !defined(__LANGUAGE_DERIVE_GENERIC1__) $(Generics.deriveMeta 'NASShow1) $(Generics.deriveRepresentable1 'NASShow2) -# endif +#endif -# if __GLASGOW_HASKELL__ < 706 +#if __GLASGOW_HASKELL__ < 706 $(Generics.deriveRepresentable0 'NASShow1) -# endif #endif ------------------------------------------------------------------------------- diff --git a/tests/Derived/DatatypeContexts.hs b/tests/Derived/DatatypeContexts.hs --- a/tests/Derived/DatatypeContexts.hs +++ b/tests/Derived/DatatypeContexts.hs @@ -76,17 +76,16 @@ instance (Ord a, TextShow a) => TextShow2 (TyCon a) where liftShowbPrec2 = $(makeLiftShowbPrec2 ''TyCon) -#if MIN_VERSION_template_haskell(2,7,0) -# if !defined(NEW_FUNCTOR_CLASSES) +#if !defined(NEW_FUNCTOR_CLASSES) instance (Ord a, Show a, Show b) => Show1 (TyFamily a b) where showsPrec1 = $(makeShowsPrec1 'TyFamily) -# else +#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 +#endif instance (Ord a, TextShow a, TextShow b, TextShow c) => TextShow (TyFamily a b c) where showbPrec = $(makeShowbPrec 'TyFamily) @@ -94,4 +93,3 @@ liftShowbPrec = $(makeLiftShowbPrec 'TyFamily) instance (Ord a, TextShow a) => TextShow2 (TyFamily a) where liftShowbPrec2 = $(makeLiftShowbPrec2 'TyFamily) -#endif diff --git a/tests/Derived/ExistentialQuantification.hs b/tests/Derived/ExistentialQuantification.hs --- a/tests/Derived/ExistentialQuantification.hs +++ b/tests/Derived/ExistentialQuantification.hs @@ -109,15 +109,13 @@ $(deriveTextShow1 ''TyCon) $(deriveTextShow2 ''TyCon) -#if MIN_VERSION_template_haskell(2,7,0) -# if !defined(NEW_FUNCTOR_CLASSES) +#if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 'TyFamilyClassConstraints) -# else +#else $(deriveShow1 'TyFamilyTypeRefinement1) $(deriveShow2 'TyFamilyTypeRefinement1) -# endif +#endif $(deriveTextShow 'TyFamilyClassConstraints) $(deriveTextShow1 'TyFamilyTypeRefinement1) $(deriveTextShow2 'TyFamilyTypeRefinement2) -#endif diff --git a/tests/Derived/Infix.hs b/tests/Derived/Infix.hs --- a/tests/Derived/Infix.hs +++ b/tests/Derived/Infix.hs @@ -1,13 +1,10 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE DeriveGeneric #-} -#endif - #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} #endif @@ -35,11 +32,9 @@ import qualified Generics.Deriving.TH as Generics #endif -#if __GLASGOW_HASKELL__ >= 702 import GHC.Generics (Generic) -# if __GLASGOW_HASKELL__ >= 706 +#if __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic1) -# endif #endif import Instances.Utils.GenericArbitrary (genericArbitrary) @@ -67,11 +62,9 @@ | a `TyConPlain` b | TyConFakeInfix a b deriving ( Show -#if __GLASGOW_HASKELL__ >= 702 , Generic -# if __GLASGOW_HASKELL__ >= 706 +#if __GLASGOW_HASKELL__ >= 706 , Generic1 -# endif #endif ) @@ -138,13 +131,11 @@ instance (Arbitrary a, Arbitrary b) => Arbitrary (TyConGADT a b) where arbitrary = genericArbitrary -#if MIN_VERSION_template_haskell(2,7,0) instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamilyPlain a b) where arbitrary = genericArbitrary instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamilyGADT a b) where arbitrary = genericArbitrary -#endif ------------------------------------------------------------------------------- @@ -169,22 +160,17 @@ $(Generics.deriveAll0And1 ''TyConGADT) #endif -#if __GLASGOW_HASKELL__ < 702 -$(Generics.deriveRepresentable0 ''TyConPlain) -#endif - -#if MIN_VERSION_template_haskell(2,7,0) -# if !defined(NEW_FUNCTOR_CLASSES) +#if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 '(:#:)) $(deriveShow1 '(:*)) -# else +#else $(deriveShow1 '(:#:)) $(deriveShow2 '(:$:)) $(deriveShow1 '(:*)) $(deriveShow2 '(:***)) -# endif +#endif $(deriveTextShow '(:#:)) $(deriveTextShow1 '(:$:)) @@ -194,15 +180,14 @@ $(deriveTextShow1 '(:***)) $(deriveTextShow2 '(:****)) -# if !defined(__LANGUAGE_DERIVE_GENERIC1__) +#if !defined(__LANGUAGE_DERIVE_GENERIC1__) $(Generics.deriveMeta '(:#:)) $(Generics.deriveRepresentable1 '(:$:)) $(Generics.deriveMeta '(:*)) $(Generics.deriveRepresentable1 '(:**)) -# endif +#endif -# if __GLASGOW_HASKELL__ < 706 +#if __GLASGOW_HASKELL__ < 706 $(Generics.deriveRepresentable0 'TyFamilyPlain) $(Generics.deriveRepresentable0 '(:***)) -# endif #endif diff --git a/tests/Derived/MagicHash.hs b/tests/Derived/MagicHash.hs --- a/tests/Derived/MagicHash.hs +++ b/tests/Derived/MagicHash.hs @@ -1,12 +1,9 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE DeriveGeneric #-} -#endif - #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} #endif @@ -86,10 +83,8 @@ instance (Arbitrary a, Arbitrary b) => Arbitrary (TyCon# a b) where arbitrary = genericArbitrary -#if MIN_VERSION_template_haskell(2,7,0) instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamily# a b) where arbitrary = genericArbitrary -#endif ------------------------------------------------------------------------------- @@ -106,19 +101,17 @@ $(Generics.deriveAll0And1 ''TyCon#) #endif -#if MIN_VERSION_template_haskell(2,7,0) -# if !defined(NEW_FUNCTOR_CLASSES) +#if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1Options legacyShowOptions 'TyFamily#) -# else +#else $(deriveShow1Options legacyShowOptions 'TyFamily#) $(deriveShow2Options legacyShowOptions 'TyFamily#) -# endif +#endif $(deriveTextShow 'TyFamily#) $(deriveTextShow1 'TyFamily#) $(deriveTextShow2 'TyFamily#) -# if __GLASGOW_HASKELL__ < 711 +#if __GLASGOW_HASKELL__ < 711 $(Generics.deriveAll0And1 'TyFamily#) -# endif #endif diff --git a/tests/Derived/PolyKinds.hs b/tests/Derived/PolyKinds.hs --- a/tests/Derived/PolyKinds.hs +++ b/tests/Derived/PolyKinds.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} @@ -8,10 +9,6 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE DeriveGeneric #-} -#endif - #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} @@ -66,9 +63,7 @@ -- NB: Don't use k as a type variable here! It'll trigger GHC Trac #12503. newtype TyConCompose f g h j p a b = TyConCompose (f (g (j a) (p a)) (h (j a) (p b))) -#if __GLASGOW_HASKELL__ >= 702 deriving Generic -#endif deriving instance Arbitrary (f (g (j a) (k a)) (h (j a) (k b))) => Arbitrary (TyConCompose f g h j k a b) @@ -88,11 +83,9 @@ TyConProxy :: () -> TyConProxy a b deriving ( Arbitrary , Show -#if __GLASGOW_HASKELL__ >= 702 , Generic -# if defined(__LANGUAGE_DERIVE_GENERIC1__) +#if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 -# endif #endif ) @@ -101,11 +94,9 @@ newtype TyConReallyHighKinds f a b c d e = TyConReallyHighKinds (f a b c d e) deriving ( Arbitrary , Show -#if __GLASGOW_HASKELL__ >= 702 , Generic -# if defined(__LANGUAGE_DERIVE_GENERIC1__) +#if defined(__LANGUAGE_DERIVE_GENERIC1__) , Generic1 -# endif #endif ) @@ -281,14 +272,7 @@ $(Generics.deriveRepresentable1 ''TyConReallyHighKinds) #endif -#if __GLASGOW_HASKELL__ < 702 -$(Generics.deriveRepresentable0 ''TyConCompose) -$(Generics.deriveRepresentable0 ''TyConProxy) -$(Generics.deriveRepresentable0 ''TyConReallyHighKinds) -#endif - -#if MIN_VERSION_template_haskell(2,7,0) -# if !defined(NEW_FUNCTOR_CLASSES) +#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 @@ -297,7 +281,7 @@ showsPrec1 = $(makeShowsPrec1 'TyFamilyProxy) instance Show1 (f a b c d) => Show1 (TyFamilyReallyHighKinds f a b c d) where showsPrec1 = $(makeShowsPrec1 'TyFamilyReallyHighKinds) -# else +#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) @@ -313,7 +297,7 @@ liftShowsPrec2 = $(makeLiftShowsPrec2 'TyFamilyProxy) instance Show2 (f a b c) => Show2 (TyFamilyReallyHighKinds f a b c) where liftShowsPrec2 = $(makeLiftShowsPrec2 'TyFamilyReallyHighKinds) -# endif +#endif instance TextShow (f (g (j a) (k a)) (h (j a) (k b))) => TextShow (TyFamilyCompose f g h j k a b) where @@ -336,7 +320,7 @@ instance TextShow2 (f a b c) => TextShow2 (TyFamilyReallyHighKinds f a b c) where liftShowbPrec2 = $(makeLiftShowbPrec2 'TyFamilyReallyHighKinds) -# if !defined(__LANGUAGE_DERIVE_GENERIC1__) +#if !defined(__LANGUAGE_DERIVE_GENERIC1__) $(Generics.deriveMeta 'TyFamilyCompose) $(Generics.deriveRep1Options False 'TyFamilyCompose) @@ -351,11 +335,10 @@ $(Generics.deriveRepresentable1 'TyFamilyProxy) $(Generics.deriveMeta 'TyFamilyReallyHighKinds) $(Generics.deriveRepresentable1 'TyFamilyReallyHighKinds) -# endif +#endif -# if __GLASGOW_HASKELL__ < 706 +#if __GLASGOW_HASKELL__ < 706 $(Generics.deriveRepresentable0 'TyFamilyCompose) $(Generics.deriveRepresentable0 'TyFamilyProxy) $(Generics.deriveRepresentable0 'TyFamilyReallyHighKinds) -# endif #endif diff --git a/tests/Derived/RankNTypes.hs b/tests/Derived/RankNTypes.hs --- a/tests/Derived/RankNTypes.hs +++ b/tests/Derived/RankNTypes.hs @@ -94,18 +94,16 @@ $(deriveTextShow1 ''TyCon) $(deriveTextShow2 ''TyCon) -#if MIN_VERSION_template_haskell(2,7,0) -# if !defined(NEW_FUNCTOR_CLASSES) +#if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 'TyFamily) -# else +#else $(deriveShow1 'TyFamily) $(deriveShow2 'TyFamily) -# endif +#endif $(deriveTextShow 'TyFamily) $(deriveTextShow1 'TyFamily) $(deriveTextShow2 'TyFamily) -#endif ------------------------------------------------------------------------------- diff --git a/tests/Derived/Records.hs b/tests/Derived/Records.hs --- a/tests/Derived/Records.hs +++ b/tests/Derived/Records.hs @@ -1,11 +1,8 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE DeriveGeneric #-} -#endif - #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} #endif @@ -28,11 +25,9 @@ import qualified Generics.Deriving.TH as Generics #endif -#if __GLASGOW_HASKELL__ >= 702 import GHC.Generics (Generic) -# if __GLASGOW_HASKELL__ >= 706 +#if __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic1) -# endif #endif import Instances.Utils.GenericArbitrary (genericArbitrary) @@ -55,11 +50,9 @@ data TyCon a b = TyConPrefix { tc1 :: a, tc2 :: b } | (:@:) { tc3 :: b, (##) :: a } deriving ( Show -#if __GLASGOW_HASKELL__ >= 702 , Generic -# if __GLASGOW_HASKELL__ >= 706 +#if __GLASGOW_HASKELL__ >= 706 , Generic1 -# endif #endif ) @@ -84,10 +77,8 @@ instance (Arbitrary a, Arbitrary b) => Arbitrary (TyCon a b) where arbitrary = genericArbitrary -#if MIN_VERSION_template_haskell(2,7,0) instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamily a b) where arbitrary = genericArbitrary -#endif ------------------------------------------------------------------------------- @@ -105,28 +96,22 @@ $(Generics.deriveRepresentable1 ''TyCon) #endif -#if __GLASGOW_HASKELL__ < 702 -$(Generics.deriveRepresentable0 ''TyCon) -#endif - -#if MIN_VERSION_template_haskell(2,7,0) -# if !defined(NEW_FUNCTOR_CLASSES) +#if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 'TyFamilyPrefix) -# else +#else $(deriveShow1 'TyFamilyPrefix) $(deriveShow2 '(:!:)) -# endif +#endif $(deriveTextShow 'TyFamilyPrefix) $(deriveTextShow1 '(:!:)) $(deriveTextShow2 'TyFamilyPrefix) -# if !defined(__LANGUAGE_DERIVE_GENERIC1__) +#if !defined(__LANGUAGE_DERIVE_GENERIC1__) $(Generics.deriveMeta 'TyFamilyPrefix) $(Generics.deriveRepresentable1 '(:!:)) -# endif +#endif -# if __GLASGOW_HASKELL__ < 706 +#if __GLASGOW_HASKELL__ < 706 $(Generics.deriveRepresentable0 'TyFamilyPrefix) -# endif #endif diff --git a/tests/Derived/TypeSynonyms.hs b/tests/Derived/TypeSynonyms.hs --- a/tests/Derived/TypeSynonyms.hs +++ b/tests/Derived/TypeSynonyms.hs @@ -1,12 +1,9 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE DeriveGeneric #-} -#endif - #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE DataKinds #-} #endif @@ -31,11 +28,9 @@ import qualified Generics.Deriving.TH as Generics #endif -#if __GLASGOW_HASKELL__ >= 702 import GHC.Generics (Generic) -# if __GLASGOW_HASKELL__ >= 706 +#if __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic1) -# endif #endif import Prelude @@ -69,11 +64,9 @@ ) deriving ( Arbitrary , Show -#if __GLASGOW_HASKELL__ >= 702 , Generic -# if __GLASGOW_HASKELL__ >= 706 +#if __GLASGOW_HASKELL__ >= 706 , Generic1 -# endif #endif ) @@ -119,28 +112,22 @@ $(Generics.deriveRepresentable1 ''TyCon) #endif -#if __GLASGOW_HASKELL__ < 702 -$(Generics.deriveRepresentable0 ''TyCon) -#endif - -#if MIN_VERSION_template_haskell(2,7,0) -# if !defined(NEW_FUNCTOR_CLASSES) +#if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 'TyFamily) -# else +#else $(deriveShow1 'TyFamily) $(deriveShow2 'TyFamily) -# endif +#endif $(deriveTextShow 'TyFamily) $(deriveTextShow1 'TyFamily) $(deriveTextShow2 'TyFamily) -# if !defined(__LANGUAGE_DERIVE_GENERIC1__) +#if !defined(__LANGUAGE_DERIVE_GENERIC1__) $(Generics.deriveMeta 'TyFamily) $(Generics.deriveRepresentable1 'TyFamily) -# endif +#endif -# if __GLASGOW_HASKELL__ < 706 +#if __GLASGOW_HASKELL__ < 706 $(Generics.deriveRepresentable0 'TyFamily) -# endif #endif 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,12 +1,5 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} - -#if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} -#endif - +{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| @@ -21,16 +14,13 @@ -} module Instances.Control.Concurrent () where -#if __GLASGOW_HASKELL__ >= 704 -import GHC.Generics (Generic) -#else -import qualified Generics.Deriving.TH as Generics (deriveAll0) -#endif +import GHC.Conc (BlockReason(..), ThreadStatus(..)) +import GHC.Generics (Generic) -import GHC.Conc (BlockReason(..), ThreadStatus(..)) -import Instances.Utils.GenericArbitrary (genericArbitrary) -import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) +import Instances.Utils.GenericArbitrary (genericArbitrary) +import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) + deriving instance Bounded BlockReason deriving instance Enum BlockReason instance Arbitrary BlockReason where @@ -39,8 +29,4 @@ instance Arbitrary ThreadStatus where arbitrary = genericArbitrary -#if __GLASGOW_HASKELL__ >= 704 deriving instance Generic ThreadStatus -#else -$(Generics.deriveAll0 ''ThreadStatus) -#endif 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 @@ -1,13 +1,7 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} - -#if __GLASGOW_HASKELL__ >= 702 -{-# LANGUAGE DeriveGeneric #-} -#endif - {-# OPTIONS_GHC -fno-warn-orphans #-} {-| @@ -22,24 +16,19 @@ -} module Instances.Control.Exception () where -import Control.Exception hiding (IOException) - -#if __GLASGOW_HASKELL__ >= 704 -import GHC.Generics (Generic) -#else -import qualified Generics.Deriving.TH as Generics (deriveAll0) -#endif +import Control.Exception hiding (IOException) -import GHC.IO.Exception (IOException(..), IOErrorType(..)) +import GHC.Generics (Generic) +import GHC.IO.Exception (IOException(..), IOErrorType(..)) -import Instances.Foreign.C.Types () -import Instances.System.IO () -import Instances.Utils.GenericArbitrary (genericArbitrary) +import Instances.Foreign.C.Types () +import Instances.System.IO () +import Instances.Utils.GenericArbitrary (genericArbitrary) -import Prelude () -import Prelude.Compat +import Prelude () +import Prelude.Compat -import Test.QuickCheck (Arbitrary(..), Gen, arbitraryBoundedEnum) +import Test.QuickCheck (Arbitrary(..), Gen, arbitraryBoundedEnum) instance Arbitrary SomeException where arbitrary = SomeException <$> (arbitrary :: Gen AssertionFailed) @@ -136,7 +125,6 @@ instance Arbitrary MaskingState where arbitrary = arbitraryBoundedEnum -#if __GLASGOW_HASKELL__ >= 704 deriving instance Generic ArrayException deriving instance Generic AssertionFailed deriving instance Generic IOException @@ -147,15 +135,3 @@ deriving instance Generic RecSelError deriving instance Generic RecUpdError deriving instance Generic ErrorCall -#else -$(Generics.deriveAll0 ''ArrayException) -$(Generics.deriveAll0 ''AssertionFailed) -$(Generics.deriveAll0 ''IOException) -$(Generics.deriveAll0 ''Deadlock) -$(Generics.deriveAll0 ''NoMethodError) -$(Generics.deriveAll0 ''PatternMatchFail) -$(Generics.deriveAll0 ''RecConError) -$(Generics.deriveAll0 ''RecSelError) -$(Generics.deriveAll0 ''RecUpdError) -$(Generics.deriveAll0 ''ErrorCall) -#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,12 +1,5 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} - -#if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} -#endif - +{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| @@ -21,21 +14,17 @@ -} module Instances.Data.Data () where -import Data.Data (Constr, ConstrRep(..), DataRep(..), DataType, - Fixity(..), mkConstr, mkDataType) +import Data.Data (Constr, ConstrRep(..), DataRep(..), DataType, + Fixity(..), mkConstr, mkDataType) -#if __GLASGOW_HASKELL__ >= 704 -import GHC.Generics (Generic) -#else -import qualified Generics.Deriving.TH as Generics (deriveAll0) -#endif +import GHC.Generics (Generic) -import Instances.Utils.GenericArbitrary (genericArbitrary) +import Instances.Utils.GenericArbitrary (genericArbitrary) -import Prelude () -import Prelude.Compat +import Prelude () +import Prelude.Compat -import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) +import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) instance Arbitrary Constr where arbitrary = mkConstr <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary @@ -54,10 +43,5 @@ instance Arbitrary Fixity where arbitrary = arbitraryBoundedEnum -#if __GLASGOW_HASKELL__ >= 704 deriving instance Generic ConstrRep deriving instance Generic DataRep -#else -$(Generics.deriveAll0 ''ConstrRep) -$(Generics.deriveAll0 ''DataRep) -#endif diff --git a/tests/Instances/Data/Functor/Compose.hs b/tests/Instances/Data/Functor/Compose.hs deleted file mode 100644 --- a/tests/Instances/Data/Functor/Compose.hs +++ /dev/null @@ -1,26 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -#if __GLASGOW_HASKELL__ >= 706 -{-# LANGUAGE PolyKinds #-} -#endif - -{-| -Module: Instances.Data.Functor.Compose -Copyright: (C) 2014-2017 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Provisional -Portability: GHC - -'Arbitrary' instance for 'Compose'. --} -module Instances.Data.Functor.Compose () where - -import Data.Functor.Compose (Compose(..)) -import Test.QuickCheck (Arbitrary) - -deriving instance Arbitrary (f (g a)) => Arbitrary (Compose f g a) diff --git a/tests/Instances/Data/Functor/Product.hs b/tests/Instances/Data/Functor/Product.hs deleted file mode 100644 --- a/tests/Instances/Data/Functor/Product.hs +++ /dev/null @@ -1,29 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -#if __GLASGOW_HASKELL__ >= 706 -{-# LANGUAGE PolyKinds #-} -#endif - -{-| -Module: Instances.Data.Functor.Product -Copyright: (C) 2014-2017 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Provisional -Portability: GHC - -'Arbitrary' instance for 'Product'. --} -module Instances.Data.Functor.Product () where - -import Data.Functor.Product (Product(..)) - -import Prelude () -import Prelude.Compat - -import Test.QuickCheck (Arbitrary(..)) - -instance (Arbitrary (f a), Arbitrary (g a)) => Arbitrary (Product f g a) where - arbitrary = Pair <$> arbitrary <*> arbitrary diff --git a/tests/Instances/Data/Functor/Sum.hs b/tests/Instances/Data/Functor/Sum.hs deleted file mode 100644 --- a/tests/Instances/Data/Functor/Sum.hs +++ /dev/null @@ -1,29 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -#if __GLASGOW_HASKELL__ >= 706 -{-# LANGUAGE PolyKinds #-} -#endif - -{-| -Module: Instances.Data.Functor.Sum -Copyright: (C) 2014-2017 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Provisional -Portability: GHC - -'Arbitrary' instance for 'Sum'. --} -module Instances.Data.Functor.Sum () where - -import Data.Functor.Sum (Sum(..)) - -import Prelude () -import Prelude.Compat - -import Test.QuickCheck (Arbitrary(..), oneof) - -instance (Arbitrary (f a), Arbitrary (g a)) => Arbitrary (Sum f g a) where - arbitrary = oneof [InL <$> arbitrary, InR <$> arbitrary] diff --git a/tests/Instances/Data/Proxy.hs b/tests/Instances/Data/Proxy.hs deleted file mode 100644 --- a/tests/Instances/Data/Proxy.hs +++ /dev/null @@ -1,35 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} - -#if __GLASGOW_HASKELL__ >= 706 -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE PolyKinds #-} -#endif - -{-# OPTIONS_GHC -fno-warn-orphans #-} - -{-| -Module: Instances.Data.Proxy -Copyright: (C) 2014-2017 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Provisional -Portability: GHC - -'Arbitrary' instances for 'Proxy'. --} -module Instances.Data.Proxy () where - -import Data.Proxy (Proxy(..)) -#if __GLASGOW_HASKELL__ < 702 -import qualified Generics.Deriving.TH as Generics (deriveAll0) -#endif -import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) - -instance Arbitrary (Proxy s) where - arbitrary = arbitraryBoundedEnum - -#if __GLASGOW_HASKELL__ < 702 -$(Generics.deriveAll0 ''Proxy) -#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,8 +1,3 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| @@ -13,28 +8,13 @@ Stability: Provisional Portability: GHC -'Arbitrary' instances for datatypes in the "Data.Semigroup" module. +'Arbitrary' instance for the 'Arg' datatype. -} module Instances.Data.Semigroup () where -import Data.Semigroup (Min(..), Max(..), First(..), Last(..), - WrappedMonoid(..), Option(..), Arg(..)) -#if __GLASGOW_HASKELL__ < 702 -import qualified Generics.Deriving.TH as Generics (deriveAll0) -#endif -import Instances.Utils.GenericArbitrary (genericArbitrary) -import Test.QuickCheck (Arbitrary(..)) - -deriving instance Arbitrary a => Arbitrary (Min a) -deriving instance Arbitrary a => Arbitrary (Max a) -deriving instance Arbitrary a => Arbitrary (First a) -deriving instance Arbitrary a => Arbitrary (Last a) -deriving instance Arbitrary a => Arbitrary (WrappedMonoid a) -deriving instance Arbitrary a => Arbitrary (Option a) +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 - -#if __GLASGOW_HASKELL__ < 702 -$(Generics.deriveAll0 ''Arg) -#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,12 +1,6 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} - -#if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} -#endif - +{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-deprecations #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -22,33 +16,29 @@ -} module Instances.Data.Text () where -import Data.Text.Encoding.Error (UnicodeException(..)) -import Data.Text.Foreign (I16) -import Data.Text.Lazy.Builder (Builder, fromString) +import Data.Text.Encoding.Error (UnicodeException(..)) +import Data.Text.Foreign (I16) +import Data.Text.Lazy.Builder (Builder, fromString) #if MIN_VERSION_text(1,0,0) -import Data.Text.Encoding (Decoding(..)) -import Instances.Utils ((<@>)) +import Data.Text.Encoding (Decoding(..)) +import Instances.Utils ((<@>)) #endif #if MIN_VERSION_text(1,1,0) -import Data.Text.Internal.Fusion.Size (Size, exactSize) -import Test.QuickCheck (getNonNegative) +import Data.Text.Internal.Fusion.Size (Size, exactSize) +import Test.QuickCheck (getNonNegative) #endif -#if __GLASGOW_HASKELL__ >= 704 -import GHC.Generics (Generic) -#else -import qualified Generics.Deriving.TH as Generics (deriveAll0) -#endif +import GHC.Generics (Generic) -import Instances.Utils.GenericArbitrary (genericArbitrary) +import Instances.Utils.GenericArbitrary (genericArbitrary) -import Prelude () -import Prelude.Compat +import Prelude () +import Prelude.Compat -import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) -import Test.QuickCheck.Instances () +import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) +import Test.QuickCheck.Instances () instance Arbitrary Builder where arbitrary = fromString <$> arbitrary @@ -69,8 +59,4 @@ arbitrary = exactSize . getNonNegative <$> arbitrary #endif -#if __GLASGOW_HASKELL__ >= 704 deriving instance Generic UnicodeException -#else -$(Generics.deriveAll0 ''UnicodeException) -#endif 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,12 +1,5 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} - -#if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} -#endif - +{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| @@ -21,14 +14,10 @@ -} module Instances.Data.Tuple () where -import Data.Orphans () -#if __GLASGOW_HASKELL__ >= 704 -import GHC.Generics (Generic) -#else -import qualified Generics.Deriving.TH as Generics (deriveAll0) -#endif -import Instances.Utils.GenericArbitrary (genericArbitrary) -import Test.QuickCheck (Arbitrary(..)) +import Data.Orphans () +import GHC.Generics (Generic) +import Instances.Utils.GenericArbitrary (genericArbitrary) +import Test.QuickCheck (Arbitrary(..)) instance ( Arbitrary a , Arbitrary b @@ -110,16 +99,8 @@ ) => Arbitrary (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where arbitrary = genericArbitrary -#if __GLASGOW_HASKELL__ >= 704 deriving instance Generic (a, b, c, d, e, f, g, h, i, j, k) deriving instance Generic (a, b, c, d, e, f, g, h, i, j, k, l) deriving instance Generic (a, b, c, d, e, f, g, h, i, j, k, l, m) deriving instance Generic (a, b, c, d, e, f, g, h, i, j, k, l, m, n) deriving instance Generic (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -#else -$(Generics.deriveAll0 ''(,,,,,,,,,,)) -$(Generics.deriveAll0 ''(,,,,,,,,,,,)) -$(Generics.deriveAll0 ''(,,,,,,,,,,,,)) -$(Generics.deriveAll0 ''(,,,,,,,,,,,,,)) -$(Generics.deriveAll0 ''(,,,,,,,,,,,,,,)) -#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 @@ -23,10 +23,6 @@ #include "MachDeps.h" -#if MIN_VERSION_base(4,4,0) -import Instances.Utils ((<@>)) -#endif - #if MIN_VERSION_base(4,9,0) import GHC.Types (TyCon(..), TrName(..), Module(..)) # if WORD_SIZE_IN_BITS < 64 @@ -35,7 +31,7 @@ import GHC.Word (Word(..)) # endif import Test.QuickCheck (oneof) -#elif MIN_VERSION_base(4,4,0) +#else import Data.Typeable.Internal (TyCon(..)) #endif @@ -44,14 +40,13 @@ import GHC.Types (KindRep(..), RuntimeRep(..), TypeLitSort(..), VecCount(..), VecElem(..)) import Type.Reflection (SomeTypeRep(..), Typeable, TypeRep, typeRep) -#elif MIN_VERSION_base(4,4,0) -import Data.Typeable.Internal (TypeRep(..)) #else -import Data.Typeable (TyCon, TypeRep, mkTyCon, typeOf) +import Data.Typeable.Internal (TypeRep(..)) #endif import Instances.Foreign.Ptr () import Instances.GHC.Fingerprint () +import Instances.Utils ((<@>)) import Prelude () import Prelude.Compat @@ -104,16 +99,12 @@ arbitrary = arbitraryBoundedEnum #else /* !(MIN_VERSION_base(4,10,0) */ instance Arbitrary TypeRep where -# if MIN_VERSION_base(4,4,0) arbitrary = TypeRep <$> arbitrary <*> arbitrary -# if MIN_VERSION_base(4,8,0) +# if MIN_VERSION_base(4,8,0) <@> [] <@> [] -# else - <@> [] -# endif # else - arbitrary = typeOf <$> (arbitrary :: Gen Int) + <@> [] # endif #endif @@ -134,10 +125,8 @@ # else TyCon w1# w2# <$> arbitrary <*> arbitrary # endif -#elif MIN_VERSION_base(4,4,0) - arbitrary = TyCon <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary #else - arbitrary = mkTyCon <$> arbitrary + arbitrary = TyCon <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary #endif #if MIN_VERSION_base(4,9,0) 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,10 +1,6 @@ {-# LANGUAGE CPP #-} - -#if MIN_VERSION_base(4,5,0) {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} -#endif - {-# OPTIONS_GHC -fno-warn-orphans #-} {-| @@ -19,126 +15,9 @@ -} module Instances.Foreign.C.Types () where +#if MIN_VERSION_base(4,10,0) import Foreign.C.Types import Test.QuickCheck (Arbitrary(..)) -#if !(MIN_VERSION_base(4,5,0)) -import Data.Int -# if MIN_VERSION_base(4,4,0) -import Data.Word -# endif - -import Test.QuickCheck (Gen, arbitrarySizedBoundedIntegral, arbitrarySizedFractional) -import Unsafe.Coerce (unsafeCoerce) - -# include "HsBaseConfig.h" -#endif - -#if MIN_VERSION_base(4,5,0) -deriving instance Arbitrary CChar -deriving instance Arbitrary CSChar -deriving instance Arbitrary CUChar -deriving instance Arbitrary CShort -deriving instance Arbitrary CUShort -deriving instance Arbitrary CInt -deriving instance Arbitrary CUInt -deriving instance Arbitrary CLong -deriving instance Arbitrary CULong -deriving instance Arbitrary CLLong -deriving instance Arbitrary CULLong -deriving instance Arbitrary CFloat -deriving instance Arbitrary CDouble -deriving instance Arbitrary CPtrdiff -deriving instance Arbitrary CSize -deriving instance Arbitrary CWchar -deriving instance Arbitrary CSigAtomic -deriving instance Arbitrary CClock -deriving instance Arbitrary CTime -deriving instance Arbitrary CUSeconds -deriving instance Arbitrary CSUSeconds -deriving instance Arbitrary CIntPtr -deriving instance Arbitrary CUIntPtr -deriving instance Arbitrary CIntMax -deriving instance Arbitrary CUIntMax - -# if MIN_VERSION_base(4,10,0) deriving instance Arbitrary CBool -# endif -#else -instance Arbitrary CChar where - arbitrary = arbitrarySizedBoundedIntegral - -instance Arbitrary CSChar where - arbitrary = arbitrarySizedBoundedIntegral - -instance Arbitrary CUChar where - arbitrary = arbitrarySizedBoundedIntegral - -instance Arbitrary CShort where - arbitrary = arbitrarySizedBoundedIntegral - -instance Arbitrary CUShort where - arbitrary = arbitrarySizedBoundedIntegral - -instance Arbitrary CInt where - arbitrary = arbitrarySizedBoundedIntegral - -instance Arbitrary CUInt where - arbitrary = arbitrarySizedBoundedIntegral - -instance Arbitrary CLong where - arbitrary = arbitrarySizedBoundedIntegral - -instance Arbitrary CULong where - arbitrary = arbitrarySizedBoundedIntegral - -instance Arbitrary CLLong where - arbitrary = arbitrarySizedBoundedIntegral - -instance Arbitrary CULLong where - arbitrary = arbitrarySizedBoundedIntegral - -instance Arbitrary CFloat where - arbitrary = arbitrarySizedFractional - -instance Arbitrary CDouble where - arbitrary = arbitrarySizedFractional - -instance Arbitrary CPtrdiff where - arbitrary = arbitrarySizedBoundedIntegral - -instance Arbitrary CSize where - arbitrary = arbitrarySizedBoundedIntegral - -instance Arbitrary CWchar where - arbitrary = arbitrarySizedBoundedIntegral - -instance Arbitrary CSigAtomic where - arbitrary = arbitrarySizedBoundedIntegral - -instance Arbitrary CClock where - arbitrary = unsafeCoerce (arbitrary :: Gen HTYPE_CLOCK_T) - -instance Arbitrary CTime where - arbitrary = unsafeCoerce (arbitrary :: Gen HTYPE_TIME_T) - -# if MIN_VERSION_base(4,4,0) -instance Arbitrary CUSeconds where - arbitrary = unsafeCoerce (arbitrary :: Gen HTYPE_USECONDS_T) - -instance Arbitrary CSUSeconds where - arbitrary = unsafeCoerce (arbitrary :: Gen HTYPE_SUSECONDS_T) -# endif - -instance Arbitrary CIntPtr where - arbitrary = arbitrarySizedBoundedIntegral - -instance Arbitrary CUIntPtr where - arbitrary = arbitrarySizedBoundedIntegral - -instance Arbitrary CIntMax where - arbitrary = arbitrarySizedBoundedIntegral - -instance Arbitrary CUIntMax where - arbitrary = arbitrarySizedBoundedIntegral #endif 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 @@ -14,7 +14,7 @@ -} module Instances.GHC.Event () where -#if !defined(__GHCJS__) && !defined(mingw32_HOST_OS) && MIN_VERSION_base(4,4,0) +#if !defined(__GHCJS__) && !defined(mingw32_HOST_OS) import GHC.Event (Event, evtRead, evtWrite) import Prelude () 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,12 +1,7 @@ {-# LANGUAGE CPP #-} - -#if MIN_VERSION_base(4,4,0) {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -#endif {-| Module: Instances.GHC.Fingerprint @@ -20,24 +15,14 @@ -} module Instances.GHC.Fingerprint () where -#if MIN_VERSION_base(4,4,0) -import GHC.Fingerprint.Type (Fingerprint(..)) -# if __GLASGOW_HASKELL__ >= 704 -import GHC.Generics (Generic) -# else -import qualified Generics.Deriving.TH as Generics (deriveAll0) -# endif +import GHC.Fingerprint.Type (Fingerprint(..)) +import GHC.Generics (Generic) -import Instances.Utils.GenericArbitrary (genericArbitrary) +import Instances.Utils.GenericArbitrary (genericArbitrary) -import Test.QuickCheck (Arbitrary(..)) +import Test.QuickCheck (Arbitrary(..)) instance Arbitrary Fingerprint where arbitrary = genericArbitrary -# if __GLASGOW_HASKELL__ >= 704 deriving instance Generic Fingerprint -# else -$(Generics.deriveAll0 ''Fingerprint) -# endif -#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 @@ -1,11 +1,7 @@ -{-# LANGUAGE CPP #-} - -#if MIN_VERSION_base(4,5,0) {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-deprecations #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -#endif {-| Module: Instances.GHC.Stats @@ -19,7 +15,6 @@ -} module Instances.GHC.Stats () where -#if MIN_VERSION_base(4,5,0) import GHC.Generics (Generic) import GHC.Stats (GCStats(..)) @@ -30,4 +25,3 @@ deriving instance Generic GCStats instance Arbitrary GCStats where arbitrary = genericArbitrary -#endif diff --git a/tests/Instances/System/Exit.hs b/tests/Instances/System/Exit.hs deleted file mode 100644 --- a/tests/Instances/System/Exit.hs +++ /dev/null @@ -1,22 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} - -{-| -Module: Instances.System.Exit -Copyright: (C) 2014-2017 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Provisional -Portability: GHC - -'Arbitrary' instance for 'ExitCode'. --} -module Instances.System.Exit () where - -import Data.Orphans () -import Generics.Deriving.Base () -import Instances.Utils.GenericArbitrary (genericArbitrary) -import System.Exit (ExitCode(..)) -import Test.QuickCheck (Arbitrary(..)) - -instance Arbitrary ExitCode where - arbitrary = genericArbitrary 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,12 +1,5 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} - -#if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} -#endif - +{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| @@ -21,28 +14,20 @@ -} module Instances.System.IO () where -#if __GLASGOW_HASKELL__ >= 704 -import GHC.Generics (Generic) -#else -import qualified Generics.Deriving.TH as Generics (deriveAll0) -#endif - -#if MIN_VERSION_base(4,4,0) -import GHC.IO.Encoding.Failure (CodingFailureMode(..)) -import GHC.IO.Encoding.Types (CodingProgress(..)) -#endif - -import GHC.IO.Handle (HandlePosn(..)) +import GHC.Generics (Generic) +import GHC.IO.Encoding.Failure (CodingFailureMode(..)) +import GHC.IO.Encoding.Types (CodingProgress(..)) +import GHC.IO.Handle (HandlePosn(..)) -import Instances.Utils.GenericArbitrary (genericArbitrary) +import Instances.Utils.GenericArbitrary (genericArbitrary) -import Prelude () -import Prelude.Compat +import Prelude () +import Prelude.Compat -import System.IO (BufferMode(..), IOMode(..), Newline(..), NewlineMode(..), - SeekMode(..), Handle, stdin, stdout, stderr) +import System.IO (BufferMode(..), IOMode(..), Newline(..), NewlineMode(..), + SeekMode(..), Handle, stdin, stdout, stderr) -import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum, oneof) +import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum, oneof) instance Arbitrary Handle where arbitrary = oneof $ map pure [stdin, stdout, stderr] @@ -61,7 +46,6 @@ instance Arbitrary SeekMode where arbitrary = arbitraryBoundedEnum -#if MIN_VERSION_base(4,4,0) deriving instance Bounded CodingProgress deriving instance Enum CodingProgress instance Arbitrary CodingProgress where @@ -71,7 +55,6 @@ deriving instance Enum CodingFailureMode instance Arbitrary CodingFailureMode where arbitrary = arbitraryBoundedEnum -#endif deriving instance Bounded Newline deriving instance Enum Newline @@ -81,12 +64,6 @@ instance Arbitrary NewlineMode where arbitrary = genericArbitrary -#if __GLASGOW_HASKELL__ >= 704 deriving instance Generic HandlePosn deriving instance Generic BufferMode deriving instance Generic NewlineMode -#else -$(Generics.deriveAll0 ''HandlePosn) -$(Generics.deriveAll0 ''BufferMode) -$(Generics.deriveAll0 ''NewlineMode) -#endif 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,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} - {-# OPTIONS_GHC -fno-warn-orphans #-} {-| @@ -18,110 +17,63 @@ import Instances.Foreign.C.Types () import Instances.Foreign.Ptr () + import System.Posix.Types -import Test.QuickCheck (Arbitrary(..)) -#if !(MIN_VERSION_base(4,5,0)) -import Data.Word -import Test.QuickCheck (Gen, arbitrarySizedBoundedIntegral) -import Unsafe.Coerce (unsafeCoerce) -#endif +import Test.QuickCheck (Arbitrary(..)) #include "HsBaseConfig.h" -#if MIN_VERSION_base(4,5,0) -# if defined(HTYPE_DEV_T) +#if defined(HTYPE_DEV_T) deriving instance Arbitrary CDev -# endif -# if defined(HTYPE_INO_T) +#endif + +#if defined(HTYPE_INO_T) deriving instance Arbitrary CIno -# endif -# if defined(HTYPE_MODE_T) +#endif + +#if defined(HTYPE_MODE_T) deriving instance Arbitrary CMode -# endif -# if defined(HTYPE_OFF_T) +#endif + +#if defined(HTYPE_OFF_T) deriving instance Arbitrary COff -# endif -# if defined(HTYPE_PID_T) +#endif + +#if defined(HTYPE_PID_T) deriving instance Arbitrary CPid -# endif -# if defined(HTYPE_SSIZE_T) +#endif + +#if defined(HTYPE_SSIZE_T) deriving instance Arbitrary CSsize -# endif -# if defined(HTYPE_GID_T) +#endif + +#if defined(HTYPE_GID_T) deriving instance Arbitrary CGid -# endif -# if defined(HTYPE_NLINK_T) +#endif + +#if defined(HTYPE_NLINK_T) deriving instance Arbitrary CNlink -# endif -# if defined(HTYPE_UID_T) +#endif + +#if defined(HTYPE_UID_T) deriving instance Arbitrary CUid -# endif -# if defined(HTYPE_CC_T) +#endif + +#if defined(HTYPE_CC_T) deriving instance Arbitrary CCc -# endif -# if defined(HTYPE_SPEED_T) +#endif + +#if defined(HTYPE_SPEED_T) deriving instance Arbitrary CSpeed -# endif -# if defined(HTYPE_TCFLAG_T) +#endif + +#if defined(HTYPE_TCFLAG_T) deriving instance Arbitrary CTcflag -# endif -# if defined(HTYPE_RLIM_T) +#endif + +#if defined(HTYPE_RLIM_T) deriving instance Arbitrary CRLim -# endif -#else -# if defined(HTYPE_DEV_T) -instance Arbitrary CDev where - arbitrary = unsafeCoerce (arbitrary :: Gen HTYPE_DEV_T) -# endif -# if defined(HTYPE_INO_T) -instance Arbitrary CIno where - arbitrary = arbitrarySizedBoundedIntegral -# endif -# if defined(HTYPE_MODE_T) -instance Arbitrary CMode where - arbitrary = arbitrarySizedBoundedIntegral -# endif -# if defined(HTYPE_OFF_T) -instance Arbitrary COff where - arbitrary = arbitrarySizedBoundedIntegral -# endif -# if defined(HTYPE_PID_T) -instance Arbitrary CPid where - arbitrary = arbitrarySizedBoundedIntegral -# endif -# if defined(HTYPE_SSIZE_T) -instance Arbitrary CSsize where - arbitrary = arbitrarySizedBoundedIntegral -# endif -# if defined(HTYPE_GID_T) -instance Arbitrary CGid where - arbitrary = arbitrarySizedBoundedIntegral -# endif -# if defined(HTYPE_NLINK_T) -instance Arbitrary CNlink where - arbitrary = arbitrarySizedBoundedIntegral -# endif -# if defined(HTYPE_UID_T) -instance Arbitrary CUid where - arbitrary = arbitrarySizedBoundedIntegral -# endif -# if defined(HTYPE_CC_T) -instance Arbitrary CCc where - arbitrary = unsafeCoerce (arbitrary :: Gen HTYPE_CC_T) -# endif -# if defined(HTYPE_SPEED_T) -instance Arbitrary CSpeed where - arbitrary = unsafeCoerce (arbitrary :: Gen HTYPE_SPEED_T) -# endif -# if defined(HTYPE_TCFLAG_T) -instance Arbitrary CTcflag where - arbitrary = arbitrarySizedBoundedIntegral -# endif -# if defined(HTYPE_RLIM_T) -instance Arbitrary CRLim where - arbitrary = arbitrarySizedBoundedIntegral -# endif #endif #if MIN_VERSION_base(4,10,0) 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 @@ -15,11 +15,10 @@ import Data.Functor.Compose (Compose) import Data.Proxy (Proxy(..)) -import Instances.Data.Functor.Compose () - import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) +import Test.QuickCheck.Instances () main :: IO () main = hspec spec 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 @@ -15,11 +15,10 @@ import Data.Functor.Product (Product) import Data.Proxy (Proxy(..)) -import Instances.Data.Functor.Product () - import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) +import Test.QuickCheck.Instances () main :: IO () main = hspec spec 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 @@ -15,11 +15,10 @@ import Data.Functor.Sum (Sum) import Data.Proxy (Proxy(..)) -import Instances.Data.Functor.Sum () - import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) +import Test.QuickCheck.Instances () main :: IO () main = hspec spec 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 @@ -15,6 +15,7 @@ import Data.Orphans () import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) +import Test.QuickCheck.Instances () main :: IO () main = hspec spec 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 @@ -11,10 +11,13 @@ module Spec.Data.ProxySpec (main, spec) where import Data.Proxy (Proxy(..)) + import Generics.Deriving.Base () -import Instances.Data.Proxy () + import Spec.Utils (matchesTextShowSpec, genericTextShowSpec) + import Test.Hspec (Spec, describe, hspec, parallel) +import Test.QuickCheck.Instances () main :: IO () main = hspec spec 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 @@ -18,6 +18,7 @@ import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) +import Test.QuickCheck.Instances () main :: IO () main = hspec spec 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 @@ -16,28 +16,24 @@ -} module Spec.Derived.DataFamiliesSpec (main, spec) where -import Prelude () -import Prelude.Compat - -import Test.Hspec (Spec, hspec, parallel) - -#if MIN_VERSION_template_haskell(2,7,0) import Data.Proxy (Proxy(..)) import Derived.DataFamilies (NotAllShow) +import Prelude () +import Prelude.Compat + import Spec.Utils (matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec) -import Test.Hspec (describe) +import Test.Hspec (Spec, describe, hspec, parallel) -# if __GLASGOW_HASKELL__ >= 706 +#if __GLASGOW_HASKELL__ >= 706 import Derived.DataFamilies (KindDistinguished) -# endif +#endif -# if __GLASGOW_HASKELL__ >= 708 +#if __GLASGOW_HASKELL__ >= 708 import Derived.DataFamilies (NullaryData) import Spec.Utils (matchesTextShowSpec) -# endif #endif main :: IO () @@ -45,14 +41,13 @@ spec :: Spec spec = parallel $ do -#if MIN_VERSION_template_haskell(2,7,0) describe "NotAllShow Int Int Int Int" $ do let p :: Proxy (NotAllShow Int Int Int Int) p = Proxy matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p -# if __GLASGOW_HASKELL__ >= 706 +#if __GLASGOW_HASKELL__ >= 706 describe "KindDistinguished '() Int Int" $ do let p :: Proxy (KindDistinguished '() Int Int) p = Proxy @@ -65,14 +60,11 @@ matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p -# endif -# if __GLASGOW_HASKELL__ >= 708 +#endif +#if __GLASGOW_HASKELL__ >= 708 describe "NullaryData" $ do let p :: Proxy NullaryData p = Proxy matchesTextShowSpec p genericTextShowSpec p -# endif -#else - pure () #endif 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 @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - {-| Module: Spec.Derived.DatatypeContextsSpec Copyright: (C) 2014-2017 Ryan Scott @@ -24,7 +22,5 @@ spec = parallel $ do describe "TyCon Int Int Int" $ matchesTextShow1Spec (Proxy :: Proxy (TyCon Int Int Int)) -#if MIN_VERSION_template_haskell(2,7,0) describe "TyFamily Int Int Int" $ matchesTextShow1Spec (Proxy :: Proxy (TyFamily Int Int Int)) -#endif 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 @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - {-| Module: Spec.Derived.ExistentialQuantificationSpec Copyright: (C) 2014-2017 Ryan Scott @@ -24,7 +22,5 @@ spec = parallel $ do describe "TyCon Int Int Int Int" $ matchesTextShow1Spec (Proxy :: Proxy (TyCon Int Int Int Int)) -#if MIN_VERSION_template_haskell(2,7,0) describe "TyFamily Int Int Int Int" $ matchesTextShow1Spec (Proxy :: Proxy (TyFamily Int Int Int Int)) -#endif 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 @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - {-| Module: Spec.Derived.InfixSpec Copyright: (C) 2014-2017 Ryan Scott @@ -34,7 +32,6 @@ matchesTextShowSpec p genericTextShowSpec p genericTextShow1Spec p -#if MIN_VERSION_template_haskell(2,7,0) describe "TyFamilyPlain Int Int" $ do let p :: Proxy (TyFamilyPlain Int Int) p = Proxy @@ -47,4 +44,3 @@ matchesTextShowSpec p genericTextShowSpec p genericTextShow1Spec p -#endif 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,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-| @@ -29,11 +28,9 @@ matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p -#if MIN_VERSION_template_haskell(2,7,0) describe "TyFamily# Int Int" $ do let p :: Proxy (TyFamily# Int Int) p = Proxy matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p -#endif 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 @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - {-| Module: Spec.Derived.PolyKindsSpec Copyright: (C) 2014-2017 Ryan Scott @@ -40,7 +38,6 @@ matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p -#if MIN_VERSION_template_haskell(2,7,0) describe "TyFamilyCompose Either Either Either Maybe Maybe Int Int" $ do let p :: Proxy (TyFamilyCompose Either Either Either Maybe Maybe Int Int) p = Proxy @@ -59,4 +56,3 @@ matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p -#endif 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 @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - {-| Module: Spec.Derived.RankNTypesSpec Copyright: (C) 2014-2017 Ryan Scott @@ -24,7 +22,5 @@ spec = parallel $ do describe "TyCon Int Int" $ matchesTextShow1Spec (Proxy :: Proxy (TyCon Int Int)) -#if MIN_VERSION_template_haskell(2,7,0) describe "TyFamily Int Int" $ matchesTextShow1Spec (Proxy :: Proxy (TyFamily Int Int)) -#endif 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,5 +1,3 @@ -{-# LANGUAGE CPP #-} - {-| Module: Spec.Derived.RecordsSpec Copyright: (C) 2014-2017 Ryan Scott @@ -28,11 +26,9 @@ matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p -#if MIN_VERSION_template_haskell(2,7,0) describe "TyFamily Int Int" $ do let p :: Proxy (TyFamily Int Int) p = Proxy matchesTextShow1Spec p genericTextShowSpec p genericTextShow1Spec p -#endif 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 @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - {-| Module: Spec.Derived.TypeSynonymsSpec Copyright: (C) 2014-2017 Ryan Scott @@ -28,11 +26,9 @@ matchesTextShowSpec p genericTextShowSpec p genericTextShow1Spec p -#if MIN_VERSION_template_haskell(2,7,0) describe "TyFamily Int Int" $ do let p :: Proxy (TyFamily Int Int) p = Proxy matchesTextShowSpec p genericTextShowSpec p genericTextShow1Spec p -#endif 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 @@ -17,6 +17,7 @@ import Instances.Foreign.C.Types () import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) +import Test.QuickCheck.Instances () main :: IO () main = hspec spec @@ -65,12 +66,10 @@ matchesTextShowSpec (Proxy :: Proxy CClock) describe "CTime" $ matchesTextShowSpec (Proxy :: Proxy CTime) -#if MIN_VERSION_base(4,4,0) describe "CUSeconds" $ matchesTextShowSpec (Proxy :: Proxy CUSeconds) describe "CSUSeconds" $ matchesTextShowSpec (Proxy :: Proxy CSUSeconds) -#endif describe "CFloat" $ matchesTextShowSpec (Proxy :: Proxy CFloat) describe "CDouble" $ 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,7 +19,7 @@ import Test.Hspec (Spec, hspec, parallel) -#if !defined(__GHCJS__) && !defined(mingw32_HOST_OS) && MIN_VERSION_base(4,4,0) +#if !defined(__GHCJS__) && !defined(mingw32_HOST_OS) import Data.Proxy (Proxy(..)) import GHC.Event (Event) @@ -38,7 +38,7 @@ spec :: Spec spec = parallel $ do -#if !defined(__GHCJS__) && !defined(mingw32_HOST_OS) && MIN_VERSION_base(4,4,0) +#if !defined(__GHCJS__) && !defined(mingw32_HOST_OS) describe "Event" $ matchesTextShowSpec (Proxy :: Proxy Event) -- describe "FdKey" $ 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 @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - {-| Module: Spec.GHC.FingerprintSpec Copyright: (C) 2014-2017 Ryan Scott @@ -12,30 +10,24 @@ -} module Spec.GHC.FingerprintSpec (main, spec) where +import Data.Proxy (Proxy(..)) import Data.Orphans () +import GHC.Fingerprint.Type (Fingerprint) + import Instances.GHC.Fingerprint () import Prelude () import Prelude.Compat -import Test.Hspec (Spec, hspec, parallel) - -#if MIN_VERSION_base(4,4,0) -import Data.Proxy (Proxy(..)) -import GHC.Fingerprint.Type (Fingerprint) 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,4,0) describe "Fingerprint" $ matchesTextShowSpec (Proxy :: Proxy Fingerprint) -#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,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-deprecations #-} {-| @@ -13,28 +12,23 @@ -} module Spec.GHC.StatsSpec (main, spec) where +import Data.Proxy (Proxy(..)) + +import GHC.Stats (GCStats) + import Instances.GHC.Stats () import Prelude () import Prelude.Compat -import Test.Hspec (Spec, hspec, parallel) - -#if MIN_VERSION_base(4,5,0) -import Data.Proxy (Proxy(..)) -import GHC.Stats (GCStats) 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,5,0) describe "GCStats" $ matchesTextShowSpec (Proxy :: Proxy GCStats) -#else - pure () -#endif 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 @@ -14,6 +14,7 @@ import Numeric.Natural (Natural) import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) +import Test.QuickCheck.Instances () main :: IO () main = hspec spec 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 @@ -11,10 +11,10 @@ module Spec.System.ExitSpec (main, spec) where import Data.Proxy (Proxy(..)) -import Instances.System.Exit () import Spec.Utils (matchesTextShowSpec) import System.Exit (ExitCode) import Test.Hspec (Spec, describe, hspec, parallel) +import Test.QuickCheck () main :: IO () main = hspec spec 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 @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - {-| Module: Spec.System.IOSpec Copyright: (C) 2014-2017 Ryan Scott @@ -14,10 +12,8 @@ import Data.Proxy (Proxy(..)) -#if MIN_VERSION_base(4,4,0) import GHC.IO.Encoding.Failure (CodingFailureMode) import GHC.IO.Encoding.Types (CodingProgress) -#endif import Instances.System.IO () @@ -50,12 +46,10 @@ matchesTextShowSpec (Proxy :: Proxy SeekMode) describe "TextEncoding" $ prop "TextShow instance" prop_showTextEncoding -#if MIN_VERSION_base(4,4,0) describe "CodingProgress" $ matchesTextShowSpec (Proxy :: Proxy CodingProgress) describe "CodingFailureMode" $ matchesTextShowSpec (Proxy :: Proxy CodingFailureMode) -#endif describe "Newline" $ matchesTextShowSpec (Proxy :: Proxy Newline) describe "NewlineMode" $ diff --git a/text-show.cabal b/text-show.cabal --- a/text-show.cabal +++ b/text-show.cabal @@ -1,5 +1,5 @@ name: text-show -version: 3.6 +version: 3.6.2 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 @@ -44,13 +44,12 @@ copyright: (C) 2014-2017 Ryan Scott category: Text build-type: Simple -tested-with: GHC == 7.0.4 - , GHC == 7.2.2 - , GHC == 7.4.2 +tested-with: GHC == 7.4.2 , GHC == 7.6.3 , GHC == 7.8.4 , GHC == 7.10.3 , GHC == 8.0.2 + , GHC == 8.2.1 extra-source-files: CHANGELOG.md, README.md, include/*.h cabal-version: >=1.10 @@ -119,7 +118,9 @@ TextShow.Foreign.C.Types TextShow.Foreign.Ptr TextShow.Functions + TextShow.GHC.Fingerprint TextShow.GHC.Generics + TextShow.GHC.Stats TextShow.Numeric.Natural TextShow.System.Exit TextShow.System.IO @@ -129,15 +130,9 @@ -- Only exports functions if using Windows TextShow.GHC.Conc.Windows - - -- Only exports functions if base >= 4.4 - TextShow.GHC.Fingerprint - -- Only exports functions if base >= 4.4 and not using Windows + -- Only exports functions if not using Windows TextShow.GHC.Event - -- Only exports functions if base >= 4.5 - TextShow.GHC.Stats - -- Only exports functions if base >= 4.6 TextShow.GHC.TypeLits @@ -175,6 +170,7 @@ , semigroups >= 0.17 && < 1 , tagged >= 0.4.4 && < 1 , text >= 0.11.1 && < 1.3 + , th-abstraction >= 0.2.2 && < 1 , th-lift >= 0.7.6 && < 1 , void >= 0.5 && < 1 @@ -223,11 +219,7 @@ Instances.Data.Data Instances.Data.Dynamic Instances.Data.Floating - Instances.Data.Functor.Compose - Instances.Data.Functor.Product - Instances.Data.Functor.Sum Instances.Data.Ord - Instances.Data.Proxy Instances.Data.Semigroup Instances.Data.Text Instances.Data.Tuple @@ -236,9 +228,10 @@ Instances.Foreign.Ptr Instances.FromStringTextShow Instances.Generic + Instances.GHC.Fingerprint Instances.GHC.Generics + Instances.GHC.Stats Instances.Options - Instances.System.Exit Instances.System.IO Instances.System.Posix.Types Instances.Text.Read @@ -247,15 +240,9 @@ -- Only exports instances if using Windows Instances.GHC.Conc.Windows - - -- Only exports instances if base >= 4.4 - Instances.GHC.Fingerprint - -- Only exports instances if base >= 4.4 and not using Windows + -- Only exports instances if not using Windows Instances.GHC.Event - -- Only exports instances if base >= 4.5 - Instances.GHC.Stats - -- Only exports instances if base >= 4.6 Instances.GHC.TypeLits @@ -304,6 +291,7 @@ Spec.Data.TupleSpec Spec.Data.TypeableSpec Spec.Data.VersionSpec + Spec.Derived.DataFamiliesSpec Spec.Derived.DatatypeContextsSpec Spec.Derived.ExistentialQuantificationSpec Spec.Derived.InfixSpec @@ -317,7 +305,9 @@ Spec.FromStringTextShowSpec Spec.FunctionsSpec Spec.GenericSpec + Spec.GHC.FingerprintSpec Spec.GHC.GenericsSpec + Spec.GHC.StatsSpec Spec.Numeric.NaturalSpec Spec.OptionsSpec Spec.System.ExitSpec @@ -328,18 +318,9 @@ -- Only exports tests if using Windows Spec.GHC.Conc.WindowsSpec - - -- Only exports tests if base >= 4.4 - Spec.GHC.FingerprintSpec - -- Only exports tests if base >= 4.4 and not using Windows + -- Only exports tests if not using Windows Spec.GHC.EventSpec - -- Only exports tests if base >= 4.5 - Spec.GHC.StatsSpec - - -- Only exports tests if template-haskell >= 2.7 - Spec.Derived.DataFamiliesSpec - -- Only exports tests if base >= 4.6 Spec.GHC.TypeLitsSpec @@ -369,8 +350,8 @@ , hspec >= 2 && < 3 , integer-gmp , nats >= 0.1 && < 2 - , QuickCheck >= 2.9 && < 3 - , quickcheck-instances >= 0.1 && < 0.4 + , QuickCheck >= 2.10 && < 2.11 + , quickcheck-instances >= 0.3.16 && < 0.4 , semigroups >= 0.18.3 && < 1 , tagged >= 0.8.3 && < 1 , text >= 0.11.1 && < 1.3