diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,18 @@ -# 3.4.1.1 [2016.11.07] +### 3.6 [2017.04.22] +* Introduce some 'TextShow' instances for datatypes added in `base-4.10.0.0`: + * `CBool` (from `Foreign.C.Types`) + * `CBlkSize`, `CBlkCnt`, `CClockId`, `CFsBlkCnt`, `CId`, `CKey`, and `CTimer` (from `System.Posix.Types`) + * `CompactionFailed` (from `Control.Exception`) + * `(:~~:)` (from `Data.Type.Equality`) + * `TypeRep` and `SomeTypeRep` (from `Type.Reflection`) +* Remove most monomorphic `TextShow` functions, as their utility is questionable, and their maintenance burden is undeniable +* Add `showbCommaSpace`, `showtCommaSpace`, and `showtlCommaSpace` to `TextShow`. This appears quite frequently in derived `TextShow` instances, so it is likely worthwhile to define it once. +* Rename `showbVersionConcrete` to `showbVersion` in `TextShow.Data.Version` +* Add `SPECIALIZE` pragmas for `showbEFloat`, `showbFFloat`, and `showbGFloat` in `TextShow.Data.Floating`, mirroring the ones in `Numeric` +* Generalize the kind of the last type parameter for the `TextShow (Const a b)` instance, which previously had been defaulted to `*` +* Refactor test suite + +#### 3.4.1.1 [2016.11.07] * Require `criterion-1.1.4` or later. This allows the benchmarks to be run on older versions of GHC. ### 3.4.1 [2016.10.20] diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2014-2016, Ryan Scott +Copyright (c) 2014-2017, Ryan Scott All rights reserved. diff --git a/benchmarks/Bench.hs b/benchmarks/Bench.hs --- a/benchmarks/Bench.hs +++ b/benchmarks/Bench.hs @@ -4,7 +4,7 @@ {-# LANGUAGE TemplateHaskell #-} {-| Module: Bench -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional diff --git a/include/inline.h b/include/inline.h deleted file mode 100644 --- a/include/inline.h +++ /dev/null @@ -1,12 +0,0 @@ -#ifndef INLINE_H -#define INLINE_H - -#include "utils.h" - -#if __GLASGOW_HASKELL__ > 702 -# define INLINE_INST_FUN(F) OPEN_PRAGMA INLINE F CLOSE_PRAGMA -#else -# define INLINE_INST_FUN(F) -#endif - -#endif diff --git a/include/overlap.h b/include/overlap.h --- a/include/overlap.h +++ b/include/overlap.h @@ -1,15 +1,13 @@ #ifndef OVERLAP_H #define OVERLAP_H -#include "utils.h" - #if __GLASGOW_HASKELL__ >= 710 # define __LANGUAGE_OVERLAPPING_INSTANCES__ -# define __OVERLAPPABLE__ OPEN_PRAGMA OVERLAPPABLE CLOSE_PRAGMA -# define __OVERLAPPING__ OPEN_PRAGMA OVERLAPPING CLOSE_PRAGMA -# define __OVERLAPS__ OPEN_PRAGMA OVERLAPS CLOSE_PRAGMA +# define __OVERLAPPABLE__ {-# OVERLAPPABLE #-} +# define __OVERLAPPING__ {-# OVERLAPPING #-} +# define __OVERLAPS__ {-# OVERLAPS #-} #else -# define __LANGUAGE_OVERLAPPING_INSTANCES__ OPEN_PRAGMA LANGUAGE OverlappingInstances CLOSE_PRAGMA +# define __LANGUAGE_OVERLAPPING_INSTANCES__ {-# LANGUAGE OverlappingInstances #-} # define __OVERLAPPABLE__ # define __OVERLAPPING__ # define __OVERLAPS__ diff --git a/include/utils.h b/include/utils.h deleted file mode 100644 --- a/include/utils.h +++ /dev/null @@ -1,7 +0,0 @@ -#ifndef UTILS_H -#define UTILS_H - -#define OPEN_PRAGMA {-# -#define CLOSE_PRAGMA #-} - -#endif diff --git a/shared/TextShow/TH/Names.hs b/shared/TextShow/TH/Names.hs new file mode 100644 --- /dev/null +++ b/shared/TextShow/TH/Names.hs @@ -0,0 +1,125 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskell #-} + +{-| +Module: TextShow.TH.Names +Copyright: (C) 2014-2017 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Provisional +Portability: GHC + +Template Haskell names to eliminate some boilerplate. +-} +module TextShow.TH.Names ( +#if MIN_VERSION_base(4,4,0) + evtCloseValName, + eventIsValName, + fdKeyTypeName, + uniqueTypeName, + asInt64ValName, +#endif +#if MIN_VERSION_base(4,6,0) + numberTypeName, +#endif +#if MIN_VERSION_base(4,8,0) + giveGCStatsTypeName, + doCostCentresTypeName, + doHeapProfileTypeName, + doTraceTypeName, +#endif + ) where + +#if MIN_VERSION_base(4,4,0) +import Language.Haskell.TH.Syntax +#endif + +#if MIN_VERSION_base(4,7,0) +import Text.Read.Lex (Number) +#endif + +#if MIN_VERSION_base(4,8,2) +import GHC.RTS.Flags (GiveGCStats, DoCostCentres, DoHeapProfile, DoTrace) +#endif + +------------------------------------------------------------------------------- + +#if MIN_VERSION_base(4,4,0) +-- | Creates a 'Name' for a value from the "GHC.Event.Internal" module. +mkEventName_v :: String -> Name +mkEventName_v = mkNameG_v "base" "GHC.Event.Internal" + +-- | The 'Name' of 'evtClose'. +evtCloseValName :: Name +evtCloseValName = mkEventName_v "evtClose" + +-- | The 'Name' of 'eventIs'. +eventIsValName :: Name +eventIsValName = mkEventName_v "eventIs" + +-- | The 'Name' of 'FdKey'. +fdKeyTypeName :: Name +fdKeyTypeName = mkNameG_tc "base" "GHC.Event.Manager" "FdKey" + +-- | The 'Name' of 'Unique'. +uniqueTypeName :: Name +uniqueTypeName = mkNameG_tc "base" "GHC.Event.Unique" "Unique" + +-- | The 'Name' of 'asInt64' (or, 'asInt' on @base-4.10.0.0@ or later). +asInt64ValName :: Name +# if MIN_VERSION_base(4,10,0) +asInt64ValName = mkNameG_v "base" "GHC.Event.Unique" "asInt" +# else +asInt64ValName = mkNameG_v "base" "GHC.Event.Unique" "asInt64" +# endif +#endif + +#if MIN_VERSION_base(4,6,0) +-- | The 'Name' of 'Number'. +numberTypeName :: Name +# if MIN_VERSION_base(4,7,0) +numberTypeName = ''Number +# else +numberTypeName = mkNameG_tc "base" "Text.Read.Lex" "Number" +# endif +#endif + +#if MIN_VERSION_base(4,8,0) +-- | The 'Name' of 'GiveGCStats'. +giveGCStatsTypeName :: Name +# if MIN_VERSION_base(4,8,2) +giveGCStatsTypeName = ''GiveGCStats +# else +giveGCStatsTypeName = mkFlagsName_tc "GiveGCStats" +# endif + +-- | The 'Name' of 'DoCostCentres'. +doCostCentresTypeName :: Name +# if MIN_VERSION_base(4,8,2) +doCostCentresTypeName = ''DoCostCentres +# else +doCostCentresTypeName = mkFlagsName_tc "DoCostCentres" +# endif + +-- | The 'Name' of 'DoHeapProfile'. +doHeapProfileTypeName :: Name +# if MIN_VERSION_base(4,8,2) +doHeapProfileTypeName = ''DoHeapProfile +# else +doHeapProfileTypeName = mkFlagsName_tc "DoHeapProfile" +# endif + +-- | The 'Name' of 'DoTrace'. +doTraceTypeName :: Name +# if MIN_VERSION_base(4,8,2) +doTraceTypeName = ''DoTrace +# else +doTraceTypeName = mkFlagsName_tc "DoTrace" +# endif + +-- | Creates a 'Name' for a type from the "GHC.RTS.Flags" module. +# if !(MIN_VERSION_base(4,8,2)) +mkFlagsName_tc :: String -> Name +mkFlagsName_tc = mkNameG_tc "base" "GHC.RTS.Flags" +# endif +#endif diff --git a/src/TextShow.hs b/src/TextShow.hs --- a/src/TextShow.hs +++ b/src/TextShow.hs @@ -1,6 +1,6 @@ {-| Module: TextShow -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -17,6 +17,9 @@ , showbParen , showtParen , showtlParen + , showbCommaSpace + , showtCommaSpace + , showtlCommaSpace , showbSpace , showtSpace , showtlSpace diff --git a/src/TextShow/Classes.hs b/src/TextShow/Classes.hs --- a/src/TextShow/Classes.hs +++ b/src/TextShow/Classes.hs @@ -7,7 +7,7 @@ #endif {-| Module: TextShow.Classes -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -186,6 +186,12 @@ showbParen p builder | p = singleton '(' <> builder <> singleton ')' | otherwise = builder +-- | Construct a 'Builder' containing a comma followed by a space. +-- +-- /Since: 3.6/ +showbCommaSpace :: Builder +showbCommaSpace = ", " + -- | Construct a 'Builder' containing a single space character. -- -- /Since: 2/ @@ -214,6 +220,12 @@ showtParen p t | p = TS.singleton '(' <> t <> TS.singleton ')' | otherwise = t +-- | Construct a strict 'TS.Text' containing a comma followed by a space. +-- +-- /Since: 3.6/ +showtCommaSpace :: TS.Text +showtCommaSpace = ", " + -- | Construct a strict 'TS.Text' containing a single space character. -- -- /Since: 3.4/ @@ -239,6 +251,12 @@ showtlParen p t | p = TL.singleton '(' <> t <> TL.singleton ')' | otherwise = t {-# INLINE showtlParen #-} + +-- | Construct a lazy 'TL.Text' containing a comma followed by a space. +-- +-- /Since: 3.6/ +showtlCommaSpace :: TL.Text +showtlCommaSpace = ", " -- | Construct a lazy 'TL.Text' containing a single space character. -- diff --git a/src/TextShow/Control/Applicative.hs b/src/TextShow/Control/Applicative.hs --- a/src/TextShow/Control/Applicative.hs +++ b/src/TextShow/Control/Applicative.hs @@ -1,19 +1,25 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} + +#if __GLASGOW_HASKELL__ >= 706 +{-# LANGUAGE PolyKinds #-} +#endif + {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Control.Applicative -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' functions for 'Const' and 'ZipList'. +'TextShow' instances for 'Const' and 'ZipList'. /Since: 2/ -} -module TextShow.Control.Applicative (liftShowbConstPrec, liftShowbZipListPrec) where +module TextShow.Control.Applicative () where import Control.Applicative (Const(..), ZipList) @@ -24,26 +30,23 @@ import TextShow.Data.List () import TextShow.TH.Internal (deriveTextShow, deriveTextShow1) --- | Convert a 'Const' value to a 'Builder' with the given show function and precedence. --- --- /Since: 3/ -liftShowbConstPrec :: (Int -> a -> Builder) -> Int -> Const a b -> Builder -liftShowbConstPrec sp = liftShowbPrec2 sp undefined undefined undefined - --- | Convert a 'ZipList' to a 'Builder' with the given show function and precedence. --- --- /Since: 3/ -liftShowbZipListPrec :: ([a] -> Builder) -> Int -> ZipList a -> Builder -liftShowbZipListPrec sl = liftShowbPrec undefined sl - +-- | /Since: 2/ instance TextShow a => TextShow (Const a b) where - showbPrec = liftShowbPrec undefined undefined + showbPrec = liftShowbConstPrec showbPrec +-- | /Since: 2/ instance TextShow a => TextShow1 (Const a) where - liftShowbPrec = liftShowbPrec2 showbPrec showbList + liftShowbPrec _ _ = liftShowbConstPrec showbPrec +-- | /Since: 2/ instance TextShow2 Const where - liftShowbPrec2 sp1 _ _ _ p (Const x) = showbUnaryWith sp1 "Const" p x + liftShowbPrec2 sp _ _ _ = liftShowbConstPrec sp +liftShowbConstPrec :: (Int -> a -> Builder) -> Int -> Const a b -> Builder +liftShowbConstPrec sp p (Const x) = showbUnaryWith sp "Const" p x +{-# INLINE liftShowbConstPrec #-} + +-- | /Since: 2/ $(deriveTextShow ''ZipList) +-- | /Since: 2/ $(deriveTextShow1 ''ZipList) diff --git a/src/TextShow/Control/Concurrent.hs b/src/TextShow/Control/Concurrent.hs --- a/src/TextShow/Control/Concurrent.hs +++ b/src/TextShow/Control/Concurrent.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TemplateHaskell #-} @@ -6,24 +5,20 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Control.Concurrent -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' functions for concurrency-related data types. +'TextShow' instances for concurrency-related data types. /Since: 2/ -} -module TextShow.Control.Concurrent ( - showbThreadIdPrec - , showbThreadStatusPrec - , showbBlockReason - ) where +module TextShow.Control.Concurrent () where import Data.Monoid.Compat ((<>)) -import Data.Text.Lazy.Builder (Builder, fromString) +import Data.Text.Lazy.Builder (fromString) import Foreign.C.Types @@ -32,17 +27,13 @@ import GHC.Prim import TextShow.Classes (TextShow(..)) -import TextShow.Foreign.C.Types (showbCIntPrec) +import TextShow.Foreign.C.Types () import TextShow.TH.Internal (deriveTextShow) -#include "inline.h" - --- | Convert a 'ThreadId' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbThreadIdPrec :: Int -> ThreadId -> Builder -showbThreadIdPrec p t = fromString "ThreadId " <> showbCIntPrec p (getThreadId t) -{-# INLINE showbThreadIdPrec #-} +-- | /Since: 2/ +instance TextShow ThreadId where + showbPrec p t = fromString "ThreadId " <> showbPrec p (getThreadId t) + {-# INLINE showbPrec #-} -- Temporary workaround until Trac #8281 is fixed foreign import ccall unsafe "rts_getThreadId" getThreadId# :: Addr# -> CInt @@ -50,23 +41,7 @@ getThreadId :: ThreadId -> CInt getThreadId (ThreadId tid) = getThreadId# (unsafeCoerce# tid) --- | Convert a 'ThreadStatus' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbThreadStatusPrec :: Int -> ThreadStatus -> Builder -showbThreadStatusPrec = showbPrec -{-# INLINE showbThreadStatusPrec #-} - --- | Convert a 'BlockReason' to a 'Builder'. --- --- /Since: 2/ -showbBlockReason :: BlockReason -> Builder -showbBlockReason = showb -{-# INLINE showbBlockReason #-} - -instance TextShow ThreadId where - showbPrec = showbThreadIdPrec - INLINE_INST_FUN(showbPrec) - +-- | /Since: 2/ $(deriveTextShow ''ThreadStatus) +-- | /Since: 2/ $(deriveTextShow ''BlockReason) diff --git a/src/TextShow/Control/Exception.hs b/src/TextShow/Control/Exception.hs --- a/src/TextShow/Control/Exception.hs +++ b/src/TextShow/Control/Exception.hs @@ -4,50 +4,22 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Control.Exception -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' functions for 'Exception's. +'TextShow' instances for 'Exception' data types. /Since: 2/ -} -module TextShow.Control.Exception ( - showbSomeExceptionPrec - , showbIOException - , showbArithException - , showbArrayException - , showbAssertionFailed -#if MIN_VERSION_base(4,7,0) - , showbSomeAsyncException -#endif - , showbAsyncException - , showbNonTermination - , showbNestedAtomically - , showbBlockedIndefinitelyOnMVar - , showbBlockedIndefinitelyOnSTM -#if MIN_VERSION_base(4,8,0) - , showbAllocationLimitExceeded -#endif -#if MIN_VERSION_base(4,9,0) - , showbTypeError -#endif - , showbDeadlock - , showbNoMethodError - , showbPatternMatchFail - , showbRecConError - , showbRecSelError - , showbRecUpdError - , showbErrorCall - , showbMaskingState - ) where +module TextShow.Control.Exception () where import Control.Exception.Base import Data.Monoid.Compat ((<>)) -import Data.Text.Lazy.Builder (Builder, fromString) +import Data.Text.Lazy.Builder (fromString) #if MIN_VERSION_base(4,9,0) import Data.Text.Lazy.Builder (singleton) #endif @@ -59,269 +31,146 @@ import TextShow.FromStringTextShow (FromStringShow(..)) import TextShow.TH.Internal (deriveTextShow) -#include "inline.h" - --- | Convert a 'SomeException' value to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbSomeExceptionPrec :: Int -> SomeException -> Builder -showbSomeExceptionPrec p (SomeException e) = showbPrec p $ FromStringShow e -{-# INLINE showbSomeExceptionPrec #-} - --- | Convert an 'IOException' to a 'Builder'. --- --- /Since: 2/ -showbIOException :: IOException -> Builder -showbIOException = showb . FromStringShow -{-# INLINE showbIOException #-} - --- | Convert an 'ArithException' to a 'Builder'. --- --- /Since: 2/ -showbArithException :: ArithException -> Builder -showbArithException Overflow = "arithmetic overflow" -showbArithException Underflow = "arithmetic underflow" -showbArithException LossOfPrecision = "loss of precision" -showbArithException DivideByZero = "divide by zero" -showbArithException Denormal = "denormal" -#if MIN_VERSION_base(4,6,0) -showbArithException RatioZeroDenominator = "Ratio has zero denominator" -#endif - --- | Convert an 'ArrayException' to a 'Builder'. --- --- /Since: 2/ -showbArrayException :: ArrayException -> Builder -showbArrayException (IndexOutOfBounds s) - = "array index out of range" - <> (if not $ null s then ": " <> fromString s - else mempty) -showbArrayException (UndefinedElement s) - = "undefined array element" - <> (if not $ null s then ": " <> fromString s - else mempty) -{-# INLINE showbArrayException #-} - --- | Convert an 'AssertionFailed' exception to a 'Builder'. --- --- /Since: 2/ -showbAssertionFailed :: AssertionFailed -> Builder -showbAssertionFailed (AssertionFailed err) = fromString err -{-# INLINE showbAssertionFailed #-} - -#if MIN_VERSION_base(4,7,0) --- | Convert a 'SomeAsyncException' value to a 'Builder'. --- This function is only available with @base-4.7.0.0@ or later. --- --- /Since: 2/ -showbSomeAsyncException :: SomeAsyncException -> Builder -showbSomeAsyncException (SomeAsyncException e) = showb $ FromStringShow e -{-# INLINE showbSomeAsyncException #-} -#endif - --- | Convert an 'AsyncException' to a 'Builder'. --- --- /Since: 2/ -showbAsyncException :: AsyncException -> Builder -showbAsyncException StackOverflow = "stack overflow" -showbAsyncException HeapOverflow = "heap overflow" -showbAsyncException ThreadKilled = "thread killed" -showbAsyncException UserInterrupt = "user interrupt" -{-# INLINE showbAsyncException #-} - --- | Convert a 'NonTermination' exception to a 'Builder'. --- --- /Since: 2/ -showbNonTermination :: NonTermination -> Builder -showbNonTermination NonTermination = "<>" -{-# INLINE showbNonTermination #-} - --- | Convert a 'NestedAtomically' exception to a 'Builder'. --- --- /Since: 2/ -showbNestedAtomically :: NestedAtomically -> Builder -showbNestedAtomically NestedAtomically = "Control.Concurrent.STM.atomically was nested" -{-# INLINE showbNestedAtomically #-} - --- | Convert a 'BlockedIndefinitelyOnMVar' exception to a 'Builder'. --- --- /Since: 2/ -showbBlockedIndefinitelyOnMVar :: BlockedIndefinitelyOnMVar -> Builder -showbBlockedIndefinitelyOnMVar BlockedIndefinitelyOnMVar = "thread blocked indefinitely in an MVar operation" -{-# INLINE showbBlockedIndefinitelyOnMVar #-} - --- | Convert a 'BlockedIndefinitelyOnSTM' exception to a 'Builder'. --- --- /Since: 2/ -showbBlockedIndefinitelyOnSTM :: BlockedIndefinitelyOnSTM -> Builder -showbBlockedIndefinitelyOnSTM BlockedIndefinitelyOnSTM = "thread blocked indefinitely in an STM transaction" -{-# INLINE showbBlockedIndefinitelyOnSTM #-} - -#if MIN_VERSION_base(4,8,0) --- | Convert an 'AllocationLimitExceeded' exception to a 'Builder'. --- This function is only available with @base-4.8.0.0@ or later. --- --- /Since: 2/ -showbAllocationLimitExceeded :: AllocationLimitExceeded -> Builder -showbAllocationLimitExceeded AllocationLimitExceeded = "allocation limit exceeded" -{-# INLINE showbAllocationLimitExceeded #-} -#endif - -#if MIN_VERSION_base(4,9,0) --- | Convert a 'TypeError' to a 'Builder'. --- This function is only available with @base-4.9.0.0@ or later. --- --- /Since: 3/ -showbTypeError :: TypeError -> Builder -showbTypeError (TypeError err) = fromString err -{-# INLINE showbTypeError #-} -#endif - --- | Convert a 'Deadlock' exception to a 'Builder'. --- --- /Since: 2/ -showbDeadlock :: Deadlock -> Builder -showbDeadlock Deadlock = "<>" -{-# INLINE showbDeadlock #-} - --- | Convert a 'NoMethodError' to a 'Builder'. --- --- /Since: 2/ -showbNoMethodError :: NoMethodError -> Builder -showbNoMethodError (NoMethodError err) = fromString err -{-# INLINE showbNoMethodError #-} - --- | Convert a 'PatternMatchFail' to a 'Builder'. --- --- /Since: 2/ -showbPatternMatchFail :: PatternMatchFail -> Builder -showbPatternMatchFail (PatternMatchFail err) = fromString err -{-# INLINE showbPatternMatchFail #-} - --- | Convert a 'RecConError' to a 'Builder'. --- --- /Since: 2/ -showbRecConError :: RecConError -> Builder -showbRecConError (RecConError err) = fromString err -{-# INLINE showbRecConError #-} - --- | Convert a 'RecSelError' to a 'Builder'. --- --- /Since: 2/ -showbRecSelError :: RecSelError -> Builder -showbRecSelError (RecSelError err) = fromString err -{-# INLINE showbRecSelError #-} - --- | Convert a 'RecUpdError' to a 'Builder'. --- --- /Since: 2/ -showbRecUpdError :: RecUpdError -> Builder -showbRecUpdError (RecUpdError err) = fromString err -{-# INLINE showbRecUpdError #-} - --- | Convert an 'ErrorCall' to a 'Builder'. --- --- /Since: 2/ -showbErrorCall :: ErrorCall -> Builder -#if MIN_VERSION_base(4,9,0) -showbErrorCall (ErrorCallWithLocation err "") = fromString err -showbErrorCall (ErrorCallWithLocation err loc) = - fromString err <> singleton '\n' <> fromString loc -#else -showbErrorCall (ErrorCall err) = fromString err -#endif - --- | Convert a 'MaskingState' to a 'Builder'. --- --- /Since: 2/ -showbMaskingState :: MaskingState -> Builder -showbMaskingState = showb -{-# INLINE showbMaskingState #-} - +-- | /Since: 2/ instance TextShow SomeException where - showbPrec = showbSomeExceptionPrec - INLINE_INST_FUN(showbPrec) + showbPrec p (SomeException e) = showbPrec p $ FromStringShow e + {-# INLINE showbPrec #-} +-- | /Since: 2/ instance TextShow IOException where - showb = showbIOException - INLINE_INST_FUN(showb) + showb = showb . FromStringShow + {-# INLINE showb #-} +-- | /Since: 2/ instance TextShow ArithException where - showb = showbArithException - INLINE_INST_FUN(showb) + showb Overflow = "arithmetic overflow" + showb Underflow = "arithmetic underflow" + showb LossOfPrecision = "loss of precision" + showb DivideByZero = "divide by zero" + showb Denormal = "denormal" +#if MIN_VERSION_base(4,6,0) + showb RatioZeroDenominator = "Ratio has zero denominator" +#endif +-- | /Since: 2/ instance TextShow ArrayException where - showb = showbArrayException - INLINE_INST_FUN(showb) + showb (IndexOutOfBounds s) + = "array index out of range" + <> (if not $ null s then ": " <> fromString s + else mempty) + showb (UndefinedElement s) + = "undefined array element" + <> (if not $ null s then ": " <> fromString s + else mempty) + {-# INLINE showb #-} +-- | /Since: 2/ instance TextShow AssertionFailed where - showb = showbAssertionFailed - INLINE_INST_FUN(showb) + showb (AssertionFailed err) = fromString err + {-# INLINE showb #-} #if MIN_VERSION_base(4,7,0) +-- | Only available with @base-4.7.0.0@ or later. +-- +-- /Since: 2/ instance TextShow SomeAsyncException where - showb = showbSomeAsyncException + showb (SomeAsyncException e) = showb $ FromStringShow e {-# INLINE showb #-} #endif +-- | /Since: 2/ instance TextShow AsyncException where - showb = showbAsyncException - INLINE_INST_FUN(showb) + showb StackOverflow = "stack overflow" + showb HeapOverflow = "heap overflow" + showb ThreadKilled = "thread killed" + showb UserInterrupt = "user interrupt" + {-# INLINE showb #-} +-- | /Since: 2/ instance TextShow NonTermination where - showb = showbNonTermination - INLINE_INST_FUN(showb) + showb NonTermination = "<>" + {-# INLINE showb #-} +-- | /Since: 2/ instance TextShow NestedAtomically where - showb = showbNestedAtomically - INLINE_INST_FUN(showb) + showb NestedAtomically = "Control.Concurrent.STM.atomically was nested" + {-# INLINE showb #-} +-- | /Since: 2/ instance TextShow BlockedIndefinitelyOnMVar where - showb = showbBlockedIndefinitelyOnMVar - INLINE_INST_FUN(showb) + showb BlockedIndefinitelyOnMVar = "thread blocked indefinitely in an MVar operation" + {-# INLINE showb #-} +-- | /Since: 2/ instance TextShow BlockedIndefinitelyOnSTM where - showb = showbBlockedIndefinitelyOnSTM - INLINE_INST_FUN(showb) + showb BlockedIndefinitelyOnSTM = "thread blocked indefinitely in an STM transaction" + {-# INLINE showb #-} #if MIN_VERSION_base(4,8,0) +-- | Only available with @base-4.8.0.0@ or later. +-- +-- /Since: 2/ instance TextShow AllocationLimitExceeded where - showb = showbAllocationLimitExceeded + showb AllocationLimitExceeded = "allocation limit exceeded" {-# INLINE showb #-} #endif #if MIN_VERSION_base(4,9,0) +-- | Only available with @base-4.9.0.0@ or later. +-- +-- /Since: 3/ instance TextShow TypeError where - showb = showbTypeError + showb (TypeError err) = fromString err {-# INLINE showb #-} #endif +#if MIN_VERSION_base(4,10,0) +-- | Only available with @base-4.10.0.0@ or later. +-- +-- /Since: 3.6/ +instance TextShow CompactionFailed where + showb (CompactionFailed why) = fromString ("compaction failed: " <> why) +#endif + +-- | /Since: 2/ instance TextShow Deadlock where - showb = showbDeadlock - INLINE_INST_FUN(showb) + showb Deadlock = "<>" + {-# INLINE showb #-} +-- | /Since: 2/ instance TextShow NoMethodError where - showb = showbNoMethodError - INLINE_INST_FUN(showb) + showb (NoMethodError err) = fromString err + {-# INLINE showb #-} +-- | /Since: 2/ instance TextShow PatternMatchFail where - showb = showbPatternMatchFail - INLINE_INST_FUN(showb) + showb (PatternMatchFail err) = fromString err + {-# INLINE showb #-} +-- | /Since: 2/ instance TextShow RecConError where - showb = showbRecConError - INLINE_INST_FUN(showb) + showb (RecConError err) = fromString err + {-# INLINE showb #-} +-- | /Since: 2/ instance TextShow RecSelError where - showb = showbRecSelError - INLINE_INST_FUN(showb) + showb (RecSelError err) = fromString err + {-# INLINE showb #-} +-- | /Since: 2/ instance TextShow RecUpdError where - showb = showbRecUpdError - INLINE_INST_FUN(showb) + showb (RecUpdError err) = fromString err + {-# INLINE showb #-} +-- | /Since: 2/ instance TextShow ErrorCall where - showb = showbErrorCall - INLINE_INST_FUN(showb) +#if MIN_VERSION_base(4,9,0) + showb (ErrorCallWithLocation err "") = fromString err + showb (ErrorCallWithLocation err loc) = + fromString err <> singleton '\n' <> fromString loc +#else + showb (ErrorCall err) = fromString err +#endif +-- | /Since: 2/ $(deriveTextShow ''MaskingState) diff --git a/src/TextShow/Control/Monad/ST.hs b/src/TextShow/Control/Monad/ST.hs --- a/src/TextShow/Control/Monad/ST.hs +++ b/src/TextShow/Control/Monad/ST.hs @@ -1,41 +1,33 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Control.Monad.ST -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' functions for strict 'ST' values. +'TextShow' instance for strict 'ST'. /Since: 2/ -} -module TextShow.Control.Monad.ST (showbST) where +module TextShow.Control.Monad.ST () where import Control.Monad.ST (ST) -import Data.Text.Lazy.Builder (Builder) import TextShow.Classes (TextShow(..), TextShow1(..), TextShow2(..)) -#include "inline.h" - --- | Convert a strict 'ST' value to a 'Builder'. --- --- /Since: 2/ -showbST :: ST s a -> Builder -showbST = showb -{-# INLINE showbST #-} - +-- | /Since: 2/ instance TextShow (ST s a) where showb = liftShowbPrec undefined undefined 0 - INLINE_INST_FUN(showb) + {-# INLINE showb #-} +-- | /Since: 2/ instance TextShow1 (ST s) where liftShowbPrec = liftShowbPrec2 undefined undefined - INLINE_INST_FUN(liftShowbPrec) + {-# INLINE liftShowbPrec #-} +-- | /Since: 2/ instance TextShow2 ST where liftShowbPrec2 _ _ _ _ _ _ = "<>" - INLINE_INST_FUN(liftShowbPrec2) + {-# INLINE liftShowbPrec2 #-} diff --git a/src/TextShow/Data/Array.hs b/src/TextShow/Data/Array.hs --- a/src/TextShow/Data/Array.hs +++ b/src/TextShow/Data/Array.hs @@ -1,24 +1,20 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Array -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' function for 'Array' values. +Provides 'TextShow' instances for 'Array' types, as well as the +'showbIArrayPrec' function. /Since: 2/ -} -module TextShow.Data.Array ( - showbArrayPrec - , showbUArrayPrec - , showbIArrayPrec - ) where +module TextShow.Data.Array (showbIArrayPrec) where import qualified Data.Array as Array (assocs, bounds) import Data.Array (Array) @@ -38,26 +34,6 @@ import TextShow.Data.List () import TextShow.Data.Tuple () -#include "inline.h" - --- | Convert an 'Array' value to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbArrayPrec :: (TextShow i, TextShow e, Ix i) => Int -> Array i e -> Builder -showbArrayPrec p a = showbParen (p > appPrec) $ - "array " - <> showb (Array.bounds a) - <> showbSpace - <> showb (Array.assocs a) -{-# INLINE showbArrayPrec #-} - --- | Convert a 'UArray' value to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbUArrayPrec :: (IArray UArray e, Ix i, TextShow i, TextShow e) => Int -> UArray i e -> Builder -showbUArrayPrec = showbIArrayPrec -{-# INLINE showbUArrayPrec #-} - {-# SPECIALIZE showbIArrayPrec :: (IArray UArray e, Ix i, TextShow i, TextShow e) => Int -> UArray i e -> Builder @@ -72,10 +48,16 @@ <> showbSpace <> showb (IArray.assocs a) +-- | /Since: 2/ instance (TextShow i, TextShow e, Ix i) => TextShow (Array i e) where - showbPrec = showbArrayPrec - INLINE_INST_FUN(showbPrec) + showbPrec p a = showbParen (p > appPrec) $ + "array " + <> showb (Array.bounds a) + <> showbSpace + <> showb (Array.assocs a) + {-# INLINE showbPrec #-} +-- | /Since: 2/ instance (IArray UArray e, Ix i, TextShow i, TextShow e) => TextShow (UArray i e) where - showbPrec = showbUArrayPrec - INLINE_INST_FUN(showbPrec) + showbPrec = showbIArrayPrec + {-# INLINE showbPrec #-} diff --git a/src/TextShow/Data/Bool.hs b/src/TextShow/Data/Bool.hs --- a/src/TextShow/Data/Bool.hs +++ b/src/TextShow/Data/Bool.hs @@ -2,28 +2,19 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Bool -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' function for 'Bool' values. +'TextShow' instance for 'Bool'. /Since: 2/ -} -module TextShow.Data.Bool (showbBool) where - -import Data.Text.Lazy.Builder (Builder) +module TextShow.Data.Bool () where -import TextShow.Classes (showb) import TextShow.TH.Internal (deriveTextShow) --- | Convert a 'Bool' to a 'Builder'. --- --- /Since: 2/ -showbBool :: Bool -> Builder -showbBool = showb -{-# INLINE showbBool #-} - +-- | /Since: 2/ $(deriveTextShow ''Bool) diff --git a/src/TextShow/Data/ByteString.hs b/src/TextShow/Data/ByteString.hs --- a/src/TextShow/Data/ByteString.hs +++ b/src/TextShow/Data/ByteString.hs @@ -8,28 +8,22 @@ {-| Module: TextShow.Data.ByteString -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' functions for data types in the @bytestring@ library. +'TextShow' instances for data types in the @bytestring@ library. /Since: 2/ -} -module TextShow.Data.ByteString ( - showbByteStringStrict - , showbByteStringLazy - , showbByteStringLazyPrec - , showbShortByteString - ) where +module TextShow.Data.ByteString () where import qualified Data.ByteString.Internal as BS import qualified Data.ByteString.Lazy.Internal as BL import qualified Data.ByteString.Short as SBS import Data.ByteString.Short.Internal (ShortByteString(..)) -import Data.Text.Lazy.Builder (Builder) import GHC.Exts (ByteArray#, Char(C#), Int(I#), indexCharArray#) @@ -47,17 +41,28 @@ import TextShow.TH.Internal (deriveTextShow) #endif -#include "inline.h" +------------------------------------------------------------------------ +-- Primop wrappers --- | Convert a strict 'BS.ByteString' to a 'Builder'. --- --- /Since: 2/ -{-# INLINE showbByteStringStrict #-} -showbByteStringStrict :: BS.ByteString -> Builder +data BA = BA# ByteArray# + +indexCharArray :: BA -> Int -> Char +indexCharArray (BA# ba#) (I# i#) = C# (indexCharArray# ba# i#) + +------------------------------------------------------------------------ +-- Internal utils + +asBA :: ShortByteString -> BA +asBA (SBS ba#) = BA# ba# +------------------------------------------------------------------------ + +-- | /Since: 2/ +instance TextShow BS.ByteString where + {-# INLINE showb #-} #if MIN_VERSION_bytestring(0,10,0) -showbByteStringStrict = showb . BS.unpackChars + showb = showb . BS.unpackChars #else -showbByteStringStrict = showb . unpackWith BS.w2c + showb = showb . unpackWith BS.w2c -- | /O(n)/ Converts a 'ByteString' to a '[a]', using a conversion function. unpackWith :: (Word8 -> a) -> BS.ByteString -> [a] @@ -70,36 +75,20 @@ {-# INLINE unpackWith #-} #endif --- | Convert a lazy 'BL.ByteString' to a 'Builder'. --- --- /Since: 2/ -showbByteStringLazy :: BL.ByteString -> Builder -showbByteStringLazy = showbByteStringLazyPrec 0 -{-# INLINE showbByteStringLazy #-} - --- | Convert a lazy 'BL.ByteString' to a 'Builder' with the given precedence. --- --- With @bytestring-0.10.0.0@ or later, this function ignores the precedence --- argument, since lazy 'BL.ByteString's are printed out identically to 'String's. --- On earlier versions of @bytestring@, however, lazy 'BL.ByteString's can be printed --- with parentheses (e.g., @Chunk "example" Empty@ vs. @(Chunk "example" Empty)@) --- depending on the precedence. --- --- /Since: 2/ -showbByteStringLazyPrec :: Int -> BL.ByteString -> Builder #if MIN_VERSION_bytestring(0,10,0) -showbByteStringLazyPrec _ = showb . BL.unpackChars +-- | /Since: 2/ +instance TextShow BL.ByteString where + showb = showb . BL.unpackChars + {-# INLINE showb #-} #else -showbByteStringLazyPrec = showbPrec +-- | /Since: 2/ +$(deriveTextShow ''BL.ByteString) #endif -{-# INLINE showbByteStringLazyPrec #-} --- | Convert a 'ShortByteString' to a 'Builder'. --- --- /Since: 2/ -showbShortByteString :: ShortByteString -> Builder -showbShortByteString = showb . unpackChars -{-# INLINE showbShortByteString #-} +-- | /Since: 2/ +instance TextShow ShortByteString where + showb = showb . unpackChars + {-# INLINE showb #-} -- Unpacking bytestrings into lists effeciently is a tradeoff: on the one hand -- we would like to write a tight loop that just blats the list into memory, on @@ -143,33 +132,3 @@ | i == sentinal = acc | otherwise = let !c = indexCharArray (asBA sbs) i in go sentinal (i-1) (c:acc) - ------------------------------------------------------------------------- --- Primop wrappers - -data BA = BA# ByteArray# - -indexCharArray :: BA -> Int -> Char -indexCharArray (BA# ba#) (I# i#) = C# (indexCharArray# ba# i#) - ------------------------------------------------------------------------- --- Internal utils - -asBA :: ShortByteString -> BA -asBA (SBS ba#) = BA# ba# - -instance TextShow BS.ByteString where - showb = showbByteStringStrict - INLINE_INST_FUN(showb) - -#if MIN_VERSION_bytestring(0,10,0) -instance TextShow BL.ByteString where - showbPrec = showbByteStringLazyPrec - INLINE_INST_FUN(showbPrec) -#else -$(deriveTextShow ''BL.ByteString) -#endif - -instance TextShow ShortByteString where - showb = showbShortByteString - INLINE_INST_FUN(showb) diff --git a/src/TextShow/Data/Char.hs b/src/TextShow/Data/Char.hs --- a/src/TextShow/Data/Char.hs +++ b/src/TextShow/Data/Char.hs @@ -1,16 +1,15 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Char -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' functions for 'Char' and 'String'. +'TextShow' instances and monomorphic functions for 'Char' and 'String'. /Since: 2/ -} @@ -32,11 +31,9 @@ import Prelude.Compat import TextShow.Classes (TextShow(..)) -import TextShow.Data.Integral (showbIntPrec) +import TextShow.Data.Integral () import TextShow.TH.Internal (deriveTextShow) -#include "inline.h" - -- | A table of ASCII control characters that needs to be escaped with a backslash. -- -- /Since: 2/ @@ -59,7 +56,7 @@ -- -- /Since: 2/ showbLitChar :: Char -> Builder -showbLitChar c | c > '\DEL' = singleton '\\' <> showbIntPrec 0 (ord c) +showbLitChar c | c > '\DEL' = singleton '\\' <> showb (ord c) showbLitChar '\DEL' = "\\DEL" showbLitChar '\\' = "\\\\" showbLitChar c | c >= ' ' = singleton c @@ -88,8 +85,8 @@ showbLitString ('\SO':'H':cs) = "\\SO\\&H" <> showbLitString cs showbLitString ('"':cs) = "\\\"" <> showbLitString cs showbLitString (c:d:cs) - | c > '\DEL' && isDigit d = singleton '\\' <> showbIntPrec 0 (ord c) <> "\\&" - <> singleton d <> showbLitString cs + | c > '\DEL' && isDigit d = singleton '\\' <> showb (ord c) <> "\\&" + <> singleton d <> showbLitString cs showbLitString (c:cs) = showbLitChar c <> showbLitString cs -- | Convert a 'GeneralCategory' to a 'Builder'. @@ -99,11 +96,13 @@ showbGeneralCategory = showb {-# INLINE showbGeneralCategory #-} +-- | /Since: 2/ instance TextShow Char where showb = showbChar - INLINE_INST_FUN(showb) + {-# INLINE showb #-} showbList = showbString - INLINE_INST_FUN(showbList) + {-# INLINE showbList #-} +-- | /Since: 2/ $(deriveTextShow ''GeneralCategory) 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 @@ -3,23 +3,22 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Ratio -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' function for 'Ratio' values. +'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 (showbComplexPrec) where +module TextShow.Data.Complex () where import Data.Complex (Complex) -import Data.Text.Lazy.Builder (Builder) import TextShow.Classes (TextShow(..)) import TextShow.Data.Floating () @@ -28,25 +27,10 @@ import TextShow.TH.Internal (deriveTextShow1) #endif -#include "inline.h" - --- | Convert a 'Complex' value to a 'Builder' with the given precedence. --- --- Note that on @base-4.3.0.0@, this function must have a @('TextShow' a, +-- | 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/ -#if MIN_VERSION_base(4,4,0) -showbComplexPrec :: TextShow a -#else -showbComplexPrec :: (RealFloat a, TextShow a) -#endif - => Int - -> Complex a - -> Builder -showbComplexPrec = showbPrec -{-# INLINE showbComplexPrec #-} - instance #if MIN_VERSION_base(4,4,0) TextShow a @@ -57,8 +41,11 @@ {-# SPECIALIZE instance TextShow (Complex Float) #-} {-# SPECIALIZE instance TextShow (Complex Double) #-} showbPrec = $(makeShowbPrec ''Complex) - INLINE_INST_FUN(showbPrec) + {-# INLINE showbPrec #-} #if MIN_VERSION_base(4,4,0) +-- | Only available with @base-4.4.0.0@ or later. +-- +-- /Since: 2/ $(deriveTextShow1 ''Complex) #endif diff --git a/src/TextShow/Data/Data.hs b/src/TextShow/Data/Data.hs --- a/src/TextShow/Data/Data.hs +++ b/src/TextShow/Data/Data.hs @@ -1,76 +1,37 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Data -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' functions for data types in the @Data.Data@ module. +'TextShow' instances for data types in the @Data.Data@ module. /Since: 2/ -} -module TextShow.Data.Data ( - showbConstr - , showbConstrRepPrec - , showbDataRepPrec - , showbDataTypePrec - , showbFixity - ) where +module TextShow.Data.Data () where import Data.Data (Constr, ConstrRep, DataRep, DataType, Fixity, showConstr) -import Data.Text.Lazy.Builder (Builder, fromString) +import Data.Text.Lazy.Builder (fromString) import TextShow.Classes (TextShow(..)) import TextShow.Data.List () import TextShow.Data.Ratio () import TextShow.TH.Internal (deriveTextShow) -#include "inline.h" - --- | Convert a 'DataType' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbDataTypePrec :: Int -> DataType -> Builder -showbDataTypePrec = showbPrec -{-# INLINE showbDataTypePrec #-} - --- | Convert a 'DataRep' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbDataRepPrec :: Int -> DataRep -> Builder -showbDataRepPrec = showbPrec -{-# INLINE showbDataRepPrec #-} - --- | Convert a 'Constr' to a 'Builder'. --- --- /Since: 2/ -showbConstr :: Constr -> Builder -showbConstr = fromString . showConstr -{-# INLINE showbConstr #-} - --- | Convert a 'Fixity' value to a 'Builder'. --- --- /Since: 2/ -showbFixity :: Fixity -> Builder -showbFixity = showb -{-# INLINE showbFixity #-} - --- | Convert a 'ConstrRep' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbConstrRepPrec :: Int -> ConstrRep -> Builder -showbConstrRepPrec = showbPrec -{-# INLINE showbConstrRepPrec #-} - +-- | /Since: 2/ $(deriveTextShow ''DataType) +-- | /Since: 2/ $(deriveTextShow ''DataRep) +-- | /Since: 2/ $(deriveTextShow ''ConstrRep) +-- | /Since: 2/ $(deriveTextShow ''Fixity) +-- | /Since: 2/ instance TextShow Constr where - showb = showbConstr - INLINE_INST_FUN(showb) + showb = fromString . showConstr + {-# INLINE showb #-} diff --git a/src/TextShow/Data/Dynamic.hs b/src/TextShow/Data/Dynamic.hs --- a/src/TextShow/Data/Dynamic.hs +++ b/src/TextShow/Data/Dynamic.hs @@ -1,38 +1,28 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Dynamic -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' function for 'Dynamic'. +'TextShow' instance for 'Dynamic'. /Since: 2/ -} -module TextShow.Data.Dynamic (showbDynamic) where +module TextShow.Data.Dynamic () where import Data.Dynamic (Dynamic, dynTypeRep) import Data.Monoid.Compat ((<>)) -import Data.Text.Lazy.Builder (Builder) import Prelude () import TextShow.Classes (TextShow(..)) -import TextShow.Data.Typeable (showbTypeRepPrec) - -#include "inline.h" - --- | Convert a 'Dynamic' value to a 'Builder'. --- --- /Since: 2/ -showbDynamic :: Dynamic -> Builder -showbDynamic dyn = "<<" <> showbTypeRepPrec 0 (dynTypeRep dyn) <> ">>" -{-# INLINE showbDynamic #-} +import TextShow.Data.Typeable () +-- | /Since: 2/ instance TextShow Dynamic where - showb = showbDynamic - INLINE_INST_FUN(showb) + showb dyn = "<<" <> showb (dynTypeRep dyn) <> ">>" + {-# INLINE showb #-} diff --git a/src/TextShow/Data/Either.hs b/src/TextShow/Data/Either.hs --- a/src/TextShow/Data/Either.hs +++ b/src/TextShow/Data/Either.hs @@ -1,36 +1,24 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Either -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' function for 'Either' values. +'TextShow' instance for 'Either'. /Since: 2/ -} -module TextShow.Data.Either (liftShowbEitherPrec2) where - -import Data.Text.Lazy.Builder (Builder) +module TextShow.Data.Either () where -import TextShow.Classes (liftShowbPrec2) import TextShow.TH.Internal (deriveTextShow, deriveTextShow1, deriveTextShow2) -#include "inline.h" - --- | Convert a 'Either' value to a 'Builder' with the given show functions --- and precedence. --- --- /Since: 3/ -liftShowbEitherPrec2 :: (Int -> a -> Builder) -> (Int -> b -> Builder) - -> Int -> Either a b -> Builder -liftShowbEitherPrec2 sp1 sp2 = liftShowbPrec2 sp1 undefined sp2 undefined -{-# INLINE liftShowbEitherPrec2 #-} - +-- | /Since: 2/ $(deriveTextShow ''Either) +-- | /Since: 2/ $(deriveTextShow1 ''Either) +-- | /Since: 2/ $(deriveTextShow2 ''Either) diff --git a/src/TextShow/Data/Fixed.hs b/src/TextShow/Data/Fixed.hs --- a/src/TextShow/Data/Fixed.hs +++ b/src/TextShow/Data/Fixed.hs @@ -2,13 +2,13 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Fixed -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'Show' function for 'Fixed' values. +Provides 'TextShow' instance for 'Fixed', as well as the 'showbFixed' function. /Since: 2/ -} @@ -36,8 +36,6 @@ import Data.Text.Lazy.Builder (fromString) #endif -#include "inline.h" - -- | Convert a 'Fixed' value to a 'Builder', where the first argument indicates -- whether to chop off trailing zeroes. -- @@ -88,6 +86,7 @@ {-# INLINE withDotB #-} #endif +-- | /Since: 2/ instance HasResolution a => TextShow (Fixed a) where showb = showbFixed False - INLINE_INST_FUN(showb) + {-# INLINE showb #-} diff --git a/src/TextShow/Data/Floating.hs b/src/TextShow/Data/Floating.hs --- a/src/TextShow/Data/Floating.hs +++ b/src/TextShow/Data/Floating.hs @@ -4,20 +4,18 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Floating -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' functions for floating-point types. +'TextShow' instances and monomorphic functions for floating-point types. /Since: 2/ -} module TextShow.Data.Floating ( showbRealFloatPrec - , showbFloatPrec - , showbDoublePrec , showbEFloat , showbFFloat , showbGFloat @@ -41,8 +39,6 @@ import TextShow.TH.Internal (deriveTextShow) import TextShow.Utils (i2d) -#include "inline.h" - -- | Convert a 'RealFloat' value to a 'Builder' with the given precedence. -- -- /Since: 2/ @@ -52,19 +48,15 @@ | otherwise = showbGFloat Nothing x {-# INLINE showbRealFloatPrec #-} --- | Convert a 'Float' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbFloatPrec :: Int -> Float -> Builder -showbFloatPrec = showbRealFloatPrec -{-# INLINE showbFloatPrec #-} - --- | Convert a 'Double' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbDoublePrec :: Int -> Double -> Builder -showbDoublePrec = showbRealFloatPrec -{-# INLINE showbDoublePrec #-} +{-# SPECIALIZE showbEFloat :: + Maybe Int -> Float -> Builder, + Maybe Int -> Double -> Builder #-} +{-# SPECIALIZE showbFFloat :: + Maybe Int -> Float -> Builder, + Maybe Int -> Double -> Builder #-} +{-# SPECIALIZE showbGFloat :: + Maybe Int -> Float -> Builder, + Maybe Int -> Double -> Builder #-} -- | Show a signed 'RealFloat' value -- using scientific (exponential) notation (e.g. @2.45e2@, @1.5e-3@). @@ -76,7 +68,6 @@ -- /Since: 2/ showbEFloat :: RealFloat a => Maybe Int -> a -> Builder showbEFloat = formatRealFloatB Exponent -{-# INLINE showbEFloat #-} -- | Show a signed 'RealFloat' value -- using standard decimal notation (e.g. @245000@, @0.0015@). @@ -88,7 +79,6 @@ -- /Since: 2/ showbFFloat :: RealFloat a => Maybe Int -> a -> Builder showbFFloat = formatRealFloatB Fixed -{-# INLINE showbFFloat #-} -- | Show a signed 'RealFloat' value -- using standard decimal notation for arguments whose absolute value lies @@ -101,7 +91,6 @@ -- /Since: 2/ showbGFloat :: RealFloat a => Maybe Int -> a -> Builder showbGFloat = formatRealFloatB Generic -{-# INLINE showbGFloat #-} -- | Show a signed 'RealFloat' value -- using standard decimal notation (e.g. @245000@, @0.0015@). @@ -400,12 +389,15 @@ -- TextShow instances ------------------------------------------------------------------------------- +-- | /Since: 2/ instance TextShow Float where - showbPrec = showbFloatPrec - INLINE_INST_FUN(showbPrec) + showbPrec = showbRealFloatPrec + {-# INLINE showbPrec #-} +-- | /Since: 2/ instance TextShow Double where - showbPrec = showbDoublePrec - INLINE_INST_FUN(showbPrec) + showbPrec = showbRealFloatPrec + {-# INLINE showbPrec #-} +-- | /Since: 2/ $(deriveTextShow ''FPFormat) diff --git a/src/TextShow/Data/Functor/Compose.hs b/src/TextShow/Data/Functor/Compose.hs --- a/src/TextShow/Data/Functor/Compose.hs +++ b/src/TextShow/Data/Functor/Compose.hs @@ -1,44 +1,31 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Functor.Compose -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' function for 'Compose'. +'TextShow' instance for 'Compose'. /Since: 3/ -} -module TextShow.Data.Functor.Compose (liftShowbComposePrec) where +module TextShow.Data.Functor.Compose () where import Data.Functor.Compose (Compose(..)) -import Data.Text.Lazy.Builder (Builder) - import TextShow.Classes (TextShow(..), TextShow1(..), showbPrec1, showbUnaryWith) -#include "inline.h" - --- | Convert a 'Compose' value to a 'Builder' with the given show functions --- and precedence. --- --- /Since: 3/ -liftShowbComposePrec :: (TextShow1 f, TextShow1 g) - => (Int -> a -> Builder) -> ([a] -> Builder) - -> Int -> Compose f g a -> Builder -liftShowbComposePrec sp sl p (Compose x) = - showbUnaryWith (liftShowbPrec (liftShowbPrec sp sl) - (liftShowbList sp sl)) - "Compose" p x - +-- | /Since: 3/ instance (TextShow1 f, TextShow1 g, TextShow a) => TextShow (Compose f g a) where showbPrec = showbPrec1 - INLINE_INST_FUN(showbPrec) + {-# INLINE showbPrec #-} +-- | /Since: 3/ instance (TextShow1 f, TextShow1 g) => TextShow1 (Compose f g) where - liftShowbPrec = liftShowbComposePrec - INLINE_INST_FUN(liftShowbPrec) + liftShowbPrec sp sl p (Compose x) = + showbUnaryWith (liftShowbPrec (liftShowbPrec sp sl) + (liftShowbList sp sl)) + "Compose" p x diff --git a/src/TextShow/Data/Functor/Identity.hs b/src/TextShow/Data/Functor/Identity.hs --- a/src/TextShow/Data/Functor/Identity.hs +++ b/src/TextShow/Data/Functor/Identity.hs @@ -1,42 +1,31 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Functor.Identity -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' function for 'Identity' values. +'TextShow' instance for 'Identity' values. /Since: 2/ -} -module TextShow.Data.Functor.Identity (liftShowbIdentityPrec) where +module TextShow.Data.Functor.Identity () where import Data.Functor.Identity (Identity(..)) -import Data.Text.Lazy.Builder (Builder) - import TextShow.Classes (TextShow(..), TextShow1(..), showbPrec1, showbUnaryWith) -#include "inline.h" - --- | Convert an 'Identity' value to a 'Builder' with the given show function --- and precedence. --- --- /Since: 3/ -liftShowbIdentityPrec :: (Int -> a -> Builder) -> Int -> Identity a -> Builder --- This would be equivalent to the derived instance of 'Identity' if the --- 'runIdentity' field were removed. -liftShowbIdentityPrec sp p (Identity x) = showbUnaryWith sp "Identity" p x -{-# INLINE liftShowbIdentityPrec #-} - +-- | /Since: 3/ instance TextShow a => TextShow (Identity a) where showbPrec = showbPrec1 {-# INLINE showbPrec #-} +-- | /Since: 3/ instance TextShow1 Identity where - liftShowbPrec sp _ = liftShowbIdentityPrec sp - INLINE_INST_FUN(liftShowbPrec) + -- This would be equivalent to the derived instance of 'Identity' if the + -- 'runIdentity' field were removed. + liftShowbPrec sp _ p (Identity x) = showbUnaryWith sp "Identity" p x + {-# INLINE liftShowbPrec #-} diff --git a/src/TextShow/Data/Functor/Product.hs b/src/TextShow/Data/Functor/Product.hs --- a/src/TextShow/Data/Functor/Product.hs +++ b/src/TextShow/Data/Functor/Product.hs @@ -1,42 +1,30 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Functor.Product -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' function for 'Product'. +'TextShow' instance for 'Product'. /Since: 3/ -} -module TextShow.Data.Functor.Product (liftShowbProductPrec) where +module TextShow.Data.Functor.Product () where import Data.Functor.Product (Product(..)) -import Data.Text.Lazy.Builder (Builder) import TextShow.Classes (TextShow(..), TextShow1(..), showbPrec1) import TextShow.TH.Internal (deriveTextShow1) -#include "inline.h" - --- | Convert a 'Product' value to a 'Builder' with the given show functions --- and precedence. --- --- /Since: 3/ -liftShowbProductPrec :: (TextShow1 f, TextShow1 g) - => (Int -> a -> Builder) -> ([a] -> Builder) - -> Int -> Product f g a -> Builder -liftShowbProductPrec = liftShowbPrec -{-# INLINE liftShowbProductPrec #-} - +-- | /Since: 3/ instance (TextShow1 f, TextShow1 g, TextShow a) => TextShow (Product f g a) where showbPrec = showbPrec1 - INLINE_INST_FUN(showbPrec) + {-# INLINE showbPrec #-} +-- | /Since: 3/ $(deriveTextShow1 ''Product) diff --git a/src/TextShow/Data/Functor/Sum.hs b/src/TextShow/Data/Functor/Sum.hs --- a/src/TextShow/Data/Functor/Sum.hs +++ b/src/TextShow/Data/Functor/Sum.hs @@ -1,42 +1,30 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Functor.Sum -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' function for 'Sum'. +'TextShow' instance for 'Sum'. /Since: 3/ -} -module TextShow.Data.Functor.Sum (liftShowbSumPrec) where +module TextShow.Data.Functor.Sum () where -import Data.Functor.Sum (Sum(..)) -import Data.Text.Lazy.Builder (Builder) +import Data.Functor.Sum (Sum) import TextShow.Classes (TextShow(..), TextShow1(..), showbPrec1) import TextShow.TH.Internal (deriveTextShow1) -#include "inline.h" - --- | Convert a 'Sum' value to a 'Builder' with the given show functions --- and precedence. --- --- /Since: 3/ -liftShowbSumPrec :: (TextShow1 f, TextShow1 g) - => (Int -> a -> Builder) -> ([a] -> Builder) - -> Int -> Sum f g a -> Builder -liftShowbSumPrec = liftShowbPrec -{-# INLINE liftShowbSumPrec #-} - +-- | /Since: 3/ instance (TextShow1 f, TextShow1 g, TextShow a) => TextShow (Sum f g a) where showbPrec = showbPrec1 - INLINE_INST_FUN(showbPrec) + {-# INLINE showbPrec #-} +-- | /Since: 3/ $(deriveTextShow1 ''Sum) diff --git a/src/TextShow/Data/Integral.hs b/src/TextShow/Data/Integral.hs --- a/src/TextShow/Data/Integral.hs +++ b/src/TextShow/Data/Integral.hs @@ -4,33 +4,22 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Integral -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' functions for integral types. +'TextShow' instances and monomorphic functions for integral types. /Since: 2/ -} module TextShow.Data.Integral ( - showbIntPrec - , showbInt8Prec - , showbInt16Prec - , showbInt32Prec - , showbInt64Prec - , showbIntegerPrec - , showbIntegralPrec + showbIntegralPrec , showbIntAtBase , showbBin , showbHex , showbOct - , showbWord - , showbWord8 - , showbWord16 - , showbWord32 - , showbWord64 ) where import Data.Char (intToDigit) @@ -53,70 +42,11 @@ import TextShow.Classes (TextShow(..)) import TextShow.Utils (toString) -#include "inline.h" - --- | Convert an 'Int' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbIntPrec :: Int -> Int -> Builder -showbIntPrec (I# p) n'@(I# n) - | isTrue (n <# 0#) && isTrue (p ># 6#) = singleton '(' <> decimal n' <> singleton ')' - | otherwise = decimal n' - where -#if __GLASGOW_HASKELL__ >= 708 - isTrue :: Int# -> Bool - isTrue b = isTrue# b -#else - isTrue :: Bool -> Bool - isTrue = id -#endif - --- | Convert an 'Int8' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbInt8Prec :: Int -> Int8 -> Builder -showbInt8Prec p = showbIntPrec p . fromIntegral -{-# INLINE showbInt8Prec #-} - --- | Convert an 'Int16' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbInt16Prec :: Int -> Int16 -> Builder -showbInt16Prec p = showbIntPrec p . fromIntegral -{-# INLINE showbInt16Prec #-} - --- | Convert an 'Int32' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbInt32Prec :: Int -> Int32 -> Builder -showbInt32Prec p = showbIntPrec p . fromIntegral -{-# INLINE showbInt32Prec #-} - --- | Convert an 'Int64' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbInt64Prec :: Int -> Int64 -> Builder -#if WORD_SIZE_IN_BITS < 64 -showbInt64Prec p = showbIntegerPrec p . toInteger -#else -showbInt64Prec p = showbIntPrec p . fromIntegral -#endif -{-# INLINE showbInt64Prec #-} - --- | Convert an 'Integer' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbIntegerPrec :: Int -> Integer -> Builder -showbIntegerPrec p n - | p > 6 && n < 0 = singleton '(' <> decimal n <> singleton ')' - | otherwise = decimal n -{-# INLINE showbIntegerPrec #-} - -- | Convert an 'Integral' type to a 'Builder' with the given precedence. -- -- /Since: 2/ showbIntegralPrec :: Integral a => Int -> a -> Builder -showbIntegralPrec p = showbIntegerPrec p . toInteger +showbIntegralPrec p = showbPrec p . toInteger {-# INLINE showbIntegralPrec #-} -- | Shows a /non-negative/ 'Integral' number using the base specified by the @@ -172,81 +102,74 @@ showbOct = showbIntAtBase 8 intToDigit {-# INLINE showbOct #-} --- | Convert a 'Word' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbWord :: Word -> Builder -showbWord = decimal -{-# INLINE showbWord #-} - --- | Convert a 'Word8' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbWord8 :: Word8 -> Builder -showbWord8 = decimal -{-# INLINE showbWord8 #-} - --- | Convert a 'Word16' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbWord16 :: Word16 -> Builder -showbWord16 = decimal -{-# INLINE showbWord16 #-} - --- | Convert a 'Word32' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbWord32 :: Word32 -> Builder -showbWord32 = decimal -{-# INLINE showbWord32 #-} - --- | Convert a 'Word64' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbWord64 :: Word64 -> Builder -showbWord64 = decimal -{-# INLINE showbWord64 #-} - +-- | /Since: 2/ instance TextShow Int where - showbPrec = showbIntPrec - INLINE_INST_FUN(showbPrec) + showbPrec (I# p) n'@(I# n) + | isTrue (n <# 0#) && isTrue (p ># 6#) + = singleton '(' <> decimal n' <> singleton ')' + | otherwise + = decimal n' + where +#if __GLASGOW_HASKELL__ >= 708 + isTrue :: Int# -> Bool + isTrue b = isTrue# b +#else + isTrue :: Bool -> Bool + isTrue = id +#endif +-- | /Since: 2/ instance TextShow Int8 where - showbPrec = showbInt8Prec - INLINE_INST_FUN(showbPrec) + showbPrec p x = showbPrec p (fromIntegral x :: Int) + {-# INLINE showbPrec #-} +-- | /Since: 2/ instance TextShow Int16 where - showbPrec = showbInt16Prec - INLINE_INST_FUN(showbPrec) + showbPrec p x = showbPrec p (fromIntegral x :: Int) + {-# INLINE showbPrec #-} +-- | /Since: 2/ instance TextShow Int32 where - showbPrec = showbInt32Prec - INLINE_INST_FUN(showbPrec) + showbPrec p x = showbPrec p (fromIntegral x :: Int) + {-# INLINE showbPrec #-} +-- | /Since: 2/ instance TextShow Int64 where - showbPrec = showbInt64Prec - INLINE_INST_FUN(showbPrec) +#if WORD_SIZE_IN_BITS < 64 + showbPrec p = showbPrec p . toInteger +#else + showbPrec p x = showbPrec p (fromIntegral x :: Int) +#endif + {-# INLINE showbPrec #-} +-- | /Since: 2/ instance TextShow Integer where - showbPrec = showbIntegerPrec - INLINE_INST_FUN(showbPrec) + showbPrec p n + | p > 6 && n < 0 = singleton '(' <> decimal n <> singleton ')' + | otherwise = decimal n + {-# INLINE showbPrec #-} +-- | /Since: 2/ instance TextShow Word where - showb = showbWord - INLINE_INST_FUN(showb) + showb = decimal + {-# INLINE showb #-} +-- | /Since: 2/ instance TextShow Word8 where - showb = showbWord8 - INLINE_INST_FUN(showb) + showb = decimal + {-# INLINE showb #-} +-- | /Since: 2/ instance TextShow Word16 where - showb = showbWord16 - INLINE_INST_FUN(showb) + showb = decimal + {-# INLINE showb #-} +-- | /Since: 2/ instance TextShow Word32 where - showb = showbWord32 - INLINE_INST_FUN(showb) + showb = decimal + {-# INLINE showb #-} +-- | /Since: 2/ instance TextShow Word64 where - showb = showbWord64 - INLINE_INST_FUN(showb) + showb = decimal + {-# INLINE showb #-} diff --git a/src/TextShow/Data/List.hs b/src/TextShow/Data/List.hs --- a/src/TextShow/Data/List.hs +++ b/src/TextShow/Data/List.hs @@ -1,14 +1,14 @@ -{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.List -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Exports 'showbListWith', 'showtListWith', and 'showtlListWith'. +Exports 'showbListWith', 'showtListWith', and 'showtlListWith', +and 'TextShow' instances for lists. -} module TextShow.Data.List (showbListWith, showtListWith, showtlListWith) where @@ -16,15 +16,15 @@ import TextShow.Data.Char () import TextShow.Data.Integral () -#include "inline.h" - +-- | /Since: 2/ instance TextShow a => TextShow [a] where {-# SPECIALIZE instance TextShow [String] #-} {-# SPECIALIZE instance TextShow String #-} {-# SPECIALIZE instance TextShow [Int] #-} showb = showbList - INLINE_INST_FUN(showb) + {-# INLINE showb #-} +-- | /Since: 2/ instance TextShow1 [] where liftShowbPrec _ sl _ = sl - INLINE_INST_FUN(liftShowbPrec) + {-# INLINE liftShowbPrec #-} diff --git a/src/TextShow/Data/List/NonEmpty.hs b/src/TextShow/Data/List/NonEmpty.hs --- a/src/TextShow/Data/List/NonEmpty.hs +++ b/src/TextShow/Data/List/NonEmpty.hs @@ -3,32 +3,24 @@ {-| Module: TextShow.Data.List.NonEmpty -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' function for 'NonEmpty' lists. +'TextShow' instance for 'NonEmpty' lists. /Since: 3/ -} -module TextShow.Data.List.NonEmpty (liftShowbNonEmptyPrec) where +module TextShow.Data.List.NonEmpty () where -import Data.List.NonEmpty (NonEmpty(..)) -import Data.Text.Lazy.Builder (Builder) +import Data.List.NonEmpty (NonEmpty) -import TextShow.Classes (TextShow1(..)) import TextShow.Data.List () import TextShow.TH.Internal (deriveTextShow, deriveTextShow1) --- | Convert a 'NonEmpty' value to a 'Builder' with the given show functions --- and precedence. --- --- /Since: 3/ -liftShowbNonEmptyPrec :: (Int -> a -> Builder) -> ([a] -> Builder) - -> Int -> NonEmpty a -> Builder -liftShowbNonEmptyPrec = liftShowbPrec - +-- | /Since: 3/ $(deriveTextShow ''NonEmpty) +-- | /Since: 3/ $(deriveTextShow1 ''NonEmpty) diff --git a/src/TextShow/Data/Maybe.hs b/src/TextShow/Data/Maybe.hs --- a/src/TextShow/Data/Maybe.hs +++ b/src/TextShow/Data/Maybe.hs @@ -1,33 +1,22 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Maybe -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' function for 'Maybe' values. +'TextShow' instance for 'Maybe'. /Since: 2/ -} -module TextShow.Data.Maybe (liftShowbMaybePrec) where - -import Data.Text.Lazy.Builder (Builder) +module TextShow.Data.Maybe () where -import TextShow.Classes (liftShowbPrec) import TextShow.TH.Internal (deriveTextShow, deriveTextShow1) -#include "inline.h" - --- | Convert a 'Maybe' value to a 'Builder' with the given show function and precedence. --- --- /Since: 3/ -liftShowbMaybePrec :: (Int -> a -> Builder) -> Int -> Maybe a -> Builder -liftShowbMaybePrec sp = liftShowbPrec sp undefined -{-# INLINE liftShowbMaybePrec #-} - +-- | /Since: 2/ $(deriveTextShow ''Maybe) +-- | /Since: 2/ $(deriveTextShow1 ''Maybe) diff --git a/src/TextShow/Data/Monoid.hs b/src/TextShow/Data/Monoid.hs --- a/src/TextShow/Data/Monoid.hs +++ b/src/TextShow/Data/Monoid.hs @@ -6,130 +6,64 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Monoid -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'Show' functions for 'Monoid'-related newtypes. +'TextShow' instances for 'Monoid'-related newtypes. /Since: 2/ -} -module TextShow.Data.Monoid ( - showbAllPrec - , showbAnyPrec - , liftShowbDualPrec - , liftShowbFirstPrec - , liftShowbLastPrec - , liftShowbProductPrec - , liftShowbSumPrec -#if MIN_VERSION_base(4,8,0) - , showbAltPrec - , liftShowbAltPrec -#endif - ) where +module TextShow.Data.Monoid () where import Data.Monoid.Compat (All, Any, Dual, First, Last, Product, Sum) -import Data.Text.Lazy.Builder (Builder) -import TextShow.Classes (TextShow(..), TextShow1(..)) import TextShow.Data.Bool () import TextShow.Data.Maybe () import TextShow.TH.Internal (deriveTextShow, deriveTextShow1) #if MIN_VERSION_base(4,8,0) import Data.Monoid (Alt) +import TextShow.Classes (TextShow(..)) import TextShow.TH.Internal (makeShowbPrec) #endif -#include "inline.h" - --- | Convert an 'All' value to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbAllPrec :: Int -> All -> Builder -showbAllPrec = showbPrec -{-# INLINE showbAllPrec #-} - --- | Convert an 'Any' value to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbAnyPrec :: Int -> Any -> Builder -showbAnyPrec = showbPrec -{-# INLINE showbAnyPrec #-} - --- | Convert a 'Dual' value to a 'Builder' with the given show function and precedence. --- --- /Since: 3/ -liftShowbDualPrec :: (Int -> a -> Builder) -> Int -> Dual a -> Builder -liftShowbDualPrec sp = liftShowbPrec sp undefined -{-# INLINE liftShowbDualPrec #-} - --- | Convert a 'First' value to a 'Builder' with the given show function and precedence. --- --- /Since: 3/ -liftShowbFirstPrec :: (Int -> a -> Builder) -> Int -> First a -> Builder -liftShowbFirstPrec sp = liftShowbPrec sp undefined -{-# INLINE liftShowbFirstPrec #-} - --- | Convert a 'Last' value to a 'Builder' with the given show function and precedence. --- --- /Since: 3/ -liftShowbLastPrec :: (Int -> a -> Builder) -> Int -> Last a -> Builder -liftShowbLastPrec sp = liftShowbPrec sp undefined -{-# INLINE liftShowbLastPrec #-} - --- | Convert a 'Product' value to a 'Builder' with the given show function --- and precedence. --- --- /Since: 3/ -liftShowbProductPrec :: (Int -> a -> Builder) -> Int -> Product a -> Builder -liftShowbProductPrec sp = liftShowbPrec sp undefined -{-# INLINE liftShowbProductPrec #-} - --- | Convert a 'Sum' value to a 'Builder' with the given show function and precedence. --- --- /Since: 3/ -liftShowbSumPrec :: (Int -> a -> Builder) -> Int -> Sum a -> Builder -liftShowbSumPrec sp = liftShowbPrec sp undefined -{-# INLINE liftShowbSumPrec #-} - -#if MIN_VERSION_base(4,8,0) --- | Convert an 'Alt' value to a 'Builder' with the given precedence. --- This function is only available with @base-4.8.0.0@ or later. --- --- /Since: 2/ -showbAltPrec :: TextShow (f a) => Int -> Alt f a -> Builder -showbAltPrec = showbPrec -{-# INLINE showbAltPrec #-} - --- | Convert an 'Alt' value to a 'Builder' with the given show function and precedence. --- This function is only available with @base-4.8.0.0@ or later. --- --- /Since: 3/ -liftShowbAltPrec :: TextShow1 f => (Int -> a -> Builder) -> ([a] -> Builder) - -> Int -> Alt f a -> Builder -liftShowbAltPrec = liftShowbPrec -{-# INLINE liftShowbAltPrec #-} -#endif - +-- | /Since: 2/ $(deriveTextShow ''All) +-- | /Since: 2/ $(deriveTextShow ''Any) +-- | /Since: 2/ $(deriveTextShow ''Dual) +-- | /Since: 2/ $(deriveTextShow1 ''Dual) +-- | /Since: 2/ $(deriveTextShow ''First) +-- | /Since: 2/ $(deriveTextShow1 ''First) +-- | /Since: 2/ $(deriveTextShow ''Last) +-- | /Since: 2/ $(deriveTextShow1 ''Last) +-- | /Since: 2/ $(deriveTextShow ''Product) +-- | /Since: 2/ $(deriveTextShow1 ''Product) +-- | /Since: 2/ $(deriveTextShow ''Sum) +-- | /Since: 2/ $(deriveTextShow1 ''Sum) #if MIN_VERSION_base(4,8,0) +-- | Only available with @base-4.8.0.0@ or later. +-- +-- /Since: 2/ instance TextShow (f a) => TextShow (Alt f a) where showbPrec = $(makeShowbPrec ''Alt) +-- | Only available with @base-4.8.0.0@ or later. +-- +-- /Since: 2/ $(deriveTextShow1 ''Alt) #endif diff --git a/src/TextShow/Data/OldTypeable.hs b/src/TextShow/Data/OldTypeable.hs --- a/src/TextShow/Data/OldTypeable.hs +++ b/src/TextShow/Data/OldTypeable.hs @@ -6,71 +6,53 @@ #endif {-| Module: TextShow.Data.OldTypeable -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' functions for data types in the @OldTypeable@ module. +'TextShow' instances for data types in the @OldTypeable@ module. This module only exports functions if using @base-4.7@. /Since: 2/ -} -module TextShow.Data.OldTypeable ( -#if !(MIN_VERSION_base(4,7,0)) || MIN_VERSION_base(4,8,0) - ) where -#else - showbTyCon - , showbTypeRepPrec - ) where +module TextShow.Data.OldTypeable () where +#if MIN_VERSION_base(4,7,0) && !(MIN_VERSION_base(4,8,0)) import Data.Monoid.Compat ((<>)) import Data.OldTypeable.Internal (TyCon(TyCon, tyConName), TypeRep(..), funTc, listTc) -import Data.Text.Lazy.Builder (Builder, fromString, singleton) +import Data.Text.Lazy.Builder (fromString, singleton) import TextShow.Classes (TextShow(..), showbParen, showbSpace) import TextShow.Data.Typeable.Utils (showbArgs, showbTuple) import TextShow.Utils (isTupleString) --- | Convert a 'TyCon' to a 'Builder'. --- This function is only available with @base-4.7@. --- --- /Since: 2/ -showbTyCon :: TyCon -> Builder -showbTyCon = fromString . tyConName -{-# INLINE showbTyCon #-} - --- | Convert a 'TypeRep' to a 'Builder' with the given precedence. --- This function is only available with @base-4.7@. --- --- /Since: 2/ -showbTypeRepPrec :: Int -> TypeRep -> Builder -showbTypeRepPrec p (TypeRep _ tycon tys) = - case tys of - [] -> showbTyCon tycon - [x] | tycon == listTc -> singleton '[' <> showb x <> singleton ']' - [a,r] | tycon == funTc -> showbParen (p > 8) $ - showbPrec 9 a - <> " -> " - <> showbPrec 8 r - xs | isTupleTyCon tycon -> showbTuple xs - | otherwise -> showbParen (p > 9) $ - showbPrec p tycon - <> showbSpace - <> showbArgs showbSpace tys - -- | Does the 'TyCon' represent a tuple type constructor? isTupleTyCon :: TyCon -> Bool isTupleTyCon (TyCon _ _ _ str) = isTupleString str {-# INLINE isTupleTyCon #-} +-- | /Since: 2/ instance TextShow TyCon where - showb = showbTyCon + showb = fromString . tyConName {-# INLINE showb #-} +-- | /Since: 2/ instance TextShow TypeRep where - showbPrec = showbTypeRepPrec + showbPrec p (TypeRep _ tycon tys) = + case tys of + [] -> showb tycon + [x] | tycon == listTc -> singleton '[' <> showb x <> singleton ']' + [a,r] | tycon == funTc -> showbParen (p > 8) $ + showbPrec 9 a + <> " -> " + <> showbPrec 8 r + xs | isTupleTyCon tycon -> showbTuple xs + | otherwise -> showbParen (p > 9) $ + showbPrec p tycon + <> showbSpace + <> showbArgs showbSpace tys {-# INLINE showbPrec #-} #endif diff --git a/src/TextShow/Data/Ord.hs b/src/TextShow/Data/Ord.hs --- a/src/TextShow/Data/Ord.hs +++ b/src/TextShow/Data/Ord.hs @@ -2,42 +2,24 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Ord -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' functions for 'Ordering' and 'Down'. +'TextShow' instances for 'Ordering' and 'Down'. /Since: 2/ -} -module TextShow.Data.Ord ( - showbOrdering - , liftShowbDownPrec - ) where - -import Data.Text.Lazy.Builder (Builder) +module TextShow.Data.Ord () where import GHC.Exts (Down) - -import TextShow.Classes (showb, liftShowbPrec) import TextShow.TH.Internal (deriveTextShow, deriveTextShow1) --- | Convert a 'Ordering' to a 'Builder'. --- --- /Since: 2/ -showbOrdering :: Ordering -> Builder -showbOrdering = showb -{-# INLINE showbOrdering #-} - --- | Convert a 'Down' value to a 'Builder' with the given show function and precedence. --- --- /Since: 3/ -liftShowbDownPrec :: (Int -> a -> Builder) -> Int -> Down a -> Builder -liftShowbDownPrec sp = liftShowbPrec sp undefined -{-# INLINE liftShowbDownPrec #-} - +-- | /Since: 2/ $(deriveTextShow ''Ordering) +-- | /Since: 2/ $(deriveTextShow ''Down) +-- | /Since: 2/ $(deriveTextShow1 ''Down) diff --git a/src/TextShow/Data/Proxy.hs b/src/TextShow/Data/Proxy.hs --- a/src/TextShow/Data/Proxy.hs +++ b/src/TextShow/Data/Proxy.hs @@ -10,40 +10,32 @@ {-| Module: TextShow.Data.Proxy -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' function for 'Proxy' values. +'TextShow' instance for 'Proxy'. /Since: 2/ -} -module TextShow.Data.Proxy (showbProxy) where +module TextShow.Data.Proxy () where -import Data.Proxy (Proxy(..)) -import Data.Text.Lazy.Builder (Builder) +import Data.Proxy (Proxy) import TextShow.Classes (TextShow(..)) import TextShow.TH.Internal (deriveTextShow1, makeShowbPrec, makeShowtPrec, makeShowtlPrec) -#include "inline.h" - --- | Convert a 'Proxy' type to a 'Builder'. --- --- /Since: 2/ -showbProxy :: Proxy s -> Builder -showbProxy = showb -{-# INLINE showbProxy #-} - +-- | /Since: 2/ instance TextShow (Proxy s) where showbPrec = $(makeShowbPrec ''Proxy) showtPrec = $(makeShowtPrec ''Proxy) showtlPrec = $(makeShowtlPrec ''Proxy) - INLINE_INST_FUN(showbPrec) - INLINE_INST_FUN(showtPrec) - INLINE_INST_FUN(showtlPrec) + {-# INLINE showbPrec #-} + {-# INLINE showtPrec #-} + {-# INLINE showtlPrec #-} +-- | /Since: 2/ $(deriveTextShow1 ''Proxy) 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 @@ -3,20 +3,19 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Ratio -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' function for 'Ratio' values. +'TextShow' instance for 'Ratio'. /Since: 2/ -} -module TextShow.Data.Ratio (showbRatioPrec) where +module TextShow.Data.Ratio () where import Data.Monoid.Compat ((<>)) -import Data.Text.Lazy.Builder (Builder) import GHC.Real (Ratio(..), ratioPrec, ratioPrec1) @@ -26,27 +25,10 @@ #endif import TextShow.Data.Integral () -#include "inline.h" - --- | Convert a 'Ratio' to a 'Builder' with the given precedence. --- --- Note that on @base-4.3.0.0@, this function must have a @('Show' a, 'Integral' a)@ --- constraint instead of just a @('Show' a)@ constraint. +-- | 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/ -showbRatioPrec :: -#if MIN_VERSION_base(4,4,0) - TextShow a -#else - (TextShow a, Integral a) -#endif - => Int -> Ratio a -> Builder -showbRatioPrec p (numer :% denom) = showbParen (p > ratioPrec) $ - showbPrec ratioPrec1 numer - <> " % " - <> showbPrec ratioPrec1 denom -{-# INLINE showbRatioPrec #-} - instance #if MIN_VERSION_base(4,4,0) TextShow a @@ -55,14 +37,20 @@ #endif => TextShow (Ratio a) where {-# SPECIALIZE instance TextShow Rational #-} - showbPrec = showbRatioPrec - INLINE_INST_FUN(showbPrec) + showbPrec p (numer :% denom) = showbParen (p > ratioPrec) $ + showbPrec ratioPrec1 numer + <> " % " + <> showbPrec ratioPrec1 denom + {-# INLINE showbPrec #-} #if MIN_VERSION_base(4,4,0) +-- | Only available with @base-4.4.0.0@ or later. +-- +-- /Since: 2/ instance TextShow1 Ratio where liftShowbPrec sp _ p (numer :% denom) = showbParen (p > ratioPrec) $ sp ratioPrec1 numer <> " % " <> sp ratioPrec1 denom - INLINE_INST_FUN(liftShowbPrec) + {-# INLINE liftShowbPrec #-} #endif diff --git a/src/TextShow/Data/Semigroup.hs b/src/TextShow/Data/Semigroup.hs --- a/src/TextShow/Data/Semigroup.hs +++ b/src/TextShow/Data/Semigroup.hs @@ -1,106 +1,58 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Semigroup -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' functions for data types in the "Data.Semigroup" module. +'TextShow' instances for data types in the "Data.Semigroup" module. /Since: 3/ -} -module TextShow.Data.Semigroup ( - liftShowbMinPrec - , liftShowbMaxPrec - , liftShowbFirstPrec - , liftShowbLastPrec - , liftShowbWrappedMonoidPrec - , liftShowbOptionPrec - , liftShowbArgPrec2 - ) where +module TextShow.Data.Semigroup () where import Data.Semigroup (Min, Max, First, Last, WrappedMonoid, Option, Arg) -import Data.Text.Lazy.Builder (Builder) -import TextShow.Classes (TextShow1(..), TextShow2(..)) import TextShow.Data.Maybe () import TextShow.TH.Internal (deriveTextShow, deriveTextShow1, deriveTextShow2) --- | Convert a 'Min' value to a 'Builder' with the given show function and precedence. --- --- /Since: 3/ -liftShowbMinPrec :: (Int -> a -> Builder) -> Int -> Min a -> Builder -liftShowbMinPrec sp = liftShowbPrec sp undefined -{-# INLINE liftShowbMinPrec #-} - --- | Convert a 'Max' value to a 'Builder' with the given show function and precedence. --- --- /Since: 3/ -liftShowbMaxPrec :: (Int -> a -> Builder) -> Int -> Max a -> Builder -liftShowbMaxPrec sp = liftShowbPrec sp undefined -{-# INLINE liftShowbMaxPrec #-} - --- | Convert a 'First' value to a 'Builder' with the given show function and precedence. --- --- /Since: 3/ -liftShowbFirstPrec :: (Int -> a -> Builder) -> Int -> First a -> Builder -liftShowbFirstPrec sp = liftShowbPrec sp undefined -{-# INLINE liftShowbFirstPrec #-} - --- | Convert a 'Last' value to a 'Builder' with the given show function and precedence. --- --- /Since: 3/ -liftShowbLastPrec :: (Int -> a -> Builder) -> Int -> Last a -> Builder -liftShowbLastPrec sp = liftShowbPrec sp undefined -{-# INLINE liftShowbLastPrec #-} - --- | Convert a 'WrappedMonoid' to a 'Builder' with the given show function --- and precedence. --- --- /Since: 3/ -liftShowbWrappedMonoidPrec :: (Int -> m -> Builder) -> Int -> WrappedMonoid m -> Builder -liftShowbWrappedMonoidPrec sp = liftShowbPrec sp undefined -{-# INLINE liftShowbWrappedMonoidPrec #-} - --- | Convert an 'Option' value to a 'Builder' with the given show function --- and precedence. --- --- /Since: 3/ -liftShowbOptionPrec :: (Int -> a -> Builder) -> Int -> Option a -> Builder -liftShowbOptionPrec sp = liftShowbPrec sp undefined -{-# INLINE liftShowbOptionPrec #-} - --- | Convert an 'Arg' value to a 'Builder' with the given show functions and precedence. --- --- /Since: 3/ -liftShowbArgPrec2 :: (Int -> a -> Builder) -> (Int -> b -> Builder) - -> Int -> Arg a b -> Builder -liftShowbArgPrec2 sp1 sp2 = liftShowbPrec2 sp1 undefined sp2 undefined -{-# INLINE liftShowbArgPrec2 #-} - +-- | /Since: 3/ $(deriveTextShow ''Min) +-- | /Since: 3/ $(deriveTextShow1 ''Min) +-- | /Since: 3/ $(deriveTextShow ''Max) +-- | /Since: 3/ $(deriveTextShow1 ''Max) +-- | /Since: 3/ $(deriveTextShow ''First) +-- | /Since: 3/ $(deriveTextShow1 ''First) +-- | /Since: 3/ $(deriveTextShow ''Last) +-- | /Since: 3/ $(deriveTextShow1 ''Last) +-- | /Since: 3/ $(deriveTextShow ''WrappedMonoid) +-- | /Since: 3/ $(deriveTextShow1 ''WrappedMonoid) +-- | /Since: 3/ $(deriveTextShow ''Option) +-- | /Since: 3/ $(deriveTextShow1 ''Option) +-- | /Since: 3/ $(deriveTextShow ''Arg) +-- | /Since: 3/ $(deriveTextShow1 ''Arg) +-- | /Since: 3/ $(deriveTextShow2 ''Arg) diff --git a/src/TextShow/Data/Text.hs b/src/TextShow/Data/Text.hs --- a/src/TextShow/Data/Text.hs +++ b/src/TextShow/Data/Text.hs @@ -7,29 +7,17 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Text -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' functions for 'Text' types. +'TextShow' instances for 'Text' types. /Since: 2/ -} -module TextShow.Data.Text ( - showbText - , showbTextLazy - , showbBuilder - , showbI16Prec - , showbUnicodeException -#if MIN_VERSION_text(1,0,0) - , showbDecodingPrec -#endif -#if MIN_VERSION_text(1,1,0) - , showbSizePrec -#endif - ) where +module TextShow.Data.Text () where import Data.Monoid.Compat ((<>)) import qualified Data.Text as TS @@ -48,108 +36,57 @@ import Data.Text.Lazy.Builder (singleton) import GHC.Show (appPrec) import TextShow.Classes (showbParen) -import TextShow.Data.ByteString (showbByteStringStrict) +import TextShow.Data.ByteString () #endif #if MIN_VERSION_text(1,1,0) import Data.Text.Internal.Fusion.Size (Size) #endif -#include "inline.h" - --- | Convert a strict 'TS.Text' to a 'Builder'. --- 'showbText' should not be confused with @fromText@, as 'showbText' escapes --- certain characters (such as double quotes). --- --- /Since: 2/ -showbText :: TS.Text -> Builder -showbText = showbString . TS.unpack -{-# INLINE showbText #-} - --- | Convert a lazy 'TL.Text' to a 'Builder'. --- 'showbTextLazy' should not be confused with @fromTextLazy@, as 'showbTextLazy' --- escapes certain characters (such as double quotes). --- --- /Since: 2/ -showbTextLazy :: TL.Text -> Builder -showbTextLazy = showbString . TL.unpack -{-# INLINE showbTextLazy #-} - --- | Show a 'Builder' as if it were a 'String' (i.e., escape certain characters, --- such as double quotes). --- --- /Since: 2/ -showbBuilder :: Builder -> Builder -showbBuilder = showbTextLazy . toLazyText -{-# INLINE showbBuilder #-} - --- | Convert an 'I16' value to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbI16Prec :: Int -> I16 -> Builder -showbI16Prec = showbPrec -{-# INLINE showbI16Prec #-} - --- | Convert a 'UnicodeException' to a 'Builder'. --- --- /Since: 2/ -showbUnicodeException :: UnicodeException -> Builder -showbUnicodeException (DecodeError desc (Just w)) - = "Cannot decode byte '\\x" <> showbHex w <> "': " <> fromString desc -showbUnicodeException (DecodeError desc Nothing) - = "Cannot decode input: " <> fromString desc -showbUnicodeException (EncodeError desc (Just c)) - = "Cannot encode character '\\x" <> showbHex (fromEnum c) <> "': " <> fromString desc -showbUnicodeException (EncodeError desc Nothing) - = "Cannot encode input: " <> fromString desc - -#if MIN_VERSION_text(1,0,0) --- | Convert a 'Decoding' value to a 'Builder' with the given precedence. --- This function is only available with @text-1.0.0.0@ or later. --- --- /Since: 2/ -showbDecodingPrec :: Int -> Decoding -> Builder -showbDecodingPrec p (Some t bs _) = showbParen (p > appPrec) $ - fromString "Some " <> showbText t <> - singleton ' ' <> showbByteStringStrict bs <> - fromString " _" -{-# INLINE showbDecodingPrec #-} -#endif - -#if MIN_VERSION_text(1,1,0) --- | Convert a 'Size' value to a 'Builder' with the given precedence. --- This function is only available with @text-1.1.0.0@ or later. --- --- /Since: 2/ -showbSizePrec :: Int -> Size -> Builder -showbSizePrec = showbPrec -{-# INLINE showbSizePrec #-} -#endif - +-- | /Since: 2/ instance TextShow TS.Text where - showb = showbText - INLINE_INST_FUN(showb) + showb = showbString . TS.unpack + {-# INLINE showb #-} +-- | /Since: 2/ instance TextShow TL.Text where - showb = showbTextLazy - INLINE_INST_FUN(showb) + showb = showbString . TL.unpack + {-# INLINE showb #-} +-- | /Since: 2/ instance TextShow Builder where - showb = showbBuilder - INLINE_INST_FUN(showb) + showb = showb . toLazyText + {-# INLINE showb #-} +-- | /Since: 2/ $(deriveTextShow ''I16) +-- | /Since: 2/ instance TextShow UnicodeException where - showb = showbUnicodeException - INLINE_INST_FUN(showb) + showb (DecodeError desc (Just w)) + = "Cannot decode byte '\\x" <> showbHex w <> "': " <> fromString desc + showb (DecodeError desc Nothing) + = "Cannot decode input: " <> fromString desc + showb (EncodeError desc (Just c)) + = "Cannot encode character '\\x" <> showbHex (fromEnum c) <> "': " <> fromString desc + showb (EncodeError desc Nothing) + = "Cannot encode input: " <> fromString desc #if MIN_VERSION_text(1,0,0) +-- | Only available with @text-1.0.0.0@ or later. +-- +-- /Since: 2/ instance TextShow Decoding where - showbPrec = showbDecodingPrec - INLINE_INST_FUN(showbPrec) + showbPrec p (Some t bs _) = showbParen (p > appPrec) $ + "Some " <> showb t <> + singleton ' ' <> showb bs <> + " _" + {-# INLINE showbPrec #-} #endif #if MIN_VERSION_text(1,1,0) +-- | Only available with @text-1.1.0.0@ or later. +-- +-- /Since: 2/ $(deriveTextShow ''Size) #endif diff --git a/src/TextShow/Data/Tuple.hs b/src/TextShow/Data/Tuple.hs --- a/src/TextShow/Data/Tuple.hs +++ b/src/TextShow/Data/Tuple.hs @@ -3,224 +3,106 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Tuple -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' functions for tuple types. +'TextShow' instances for tuple types. /Since: 2/ -} -module TextShow.Data.Tuple ( - showbUnit - , liftShowb2Tuple2 - , liftShowb3Tuple2 - , liftShowb4Tuple2 - , liftShowb5Tuple2 - , liftShowb6Tuple2 - , liftShowb7Tuple2 - , liftShowb8Tuple2 - , liftShowb9Tuple2 - , liftShowb10Tuple2 - , liftShowb11Tuple2 - , liftShowb12Tuple2 - , liftShowb13Tuple2 - , liftShowb14Tuple2 - , liftShowb15Tuple2 - ) where - -import Data.Text.Lazy.Builder (Builder) +module TextShow.Data.Tuple () where -import TextShow.Classes (TextShow(..), TextShow2(..)) import TextShow.TH.Internal (deriveTextShow, deriveTextShow1, deriveTextShow2) -#include "inline.h" - --- | Converts @()@ into a 'Builder'. --- --- /Since: 2/ -showbUnit :: () -> Builder -showbUnit = showb - --- | Converts a 2-tuple into a 'Builder' with the given show functions. --- --- /Since: 3/ -liftShowb2Tuple2 :: (a -> Builder) -> (b -> Builder) - -> (a, b) -> Builder -liftShowb2Tuple2 = liftShowb2 -{-# INLINE liftShowb2Tuple2 #-} - --- | Converts a 3-tuple into a 'Builder' with the given show functions. --- --- /Since: 3/ -liftShowb3Tuple2 :: TextShow a - => (b -> Builder) -> (c -> Builder) - -> (a, b, c) -> Builder -liftShowb3Tuple2 = liftShowb2 -{-# INLINE liftShowb3Tuple2 #-} - --- | Converts a 4-tuple into a 'Builder' with the given show functions. --- --- /Since: 3/ -liftShowb4Tuple2 :: (TextShow a, TextShow b) - => (c -> Builder) -> (d -> Builder) - -> (a, b, c, d) -> Builder -liftShowb4Tuple2 = liftShowb2 -{-# INLINE liftShowb4Tuple2 #-} - --- | Converts a 5-tuple into a 'Builder' with the given show functions. --- --- /Since: 3/ -liftShowb5Tuple2 :: (TextShow a, TextShow b, TextShow c) - => (d -> Builder) -> (e -> Builder) - -> (a, b, c, d, e) -> Builder -liftShowb5Tuple2 = liftShowb2 -{-# INLINE liftShowb5Tuple2 #-} - --- | Converts a 6-tuple into a 'Builder' with the given show functions. --- --- /Since: 3/ -liftShowb6Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d) - => (e -> Builder) -> (f -> Builder) - -> (a, b, c, d, e, f) -> Builder -liftShowb6Tuple2 = liftShowb2 -{-# INLINE liftShowb6Tuple2 #-} - --- | Converts a 7-tuple into a 'Builder' with the given show functions. --- --- /Since: 3/ -liftShowb7Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e) - => (f -> Builder) -> (g -> Builder) - -> (a, b, c, d, e, f, g) -> Builder -liftShowb7Tuple2 = liftShowb2 -{-# INLINE liftShowb7Tuple2 #-} - --- | Converts an 8-tuple into a 'Builder' with the given show functions. --- --- /Since: 3/ -liftShowb8Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f) - => (g -> Builder) -> (h -> Builder) - -> (a, b, c, d, e, f, g, h) -> Builder -liftShowb8Tuple2 = liftShowb2 -{-# INLINE liftShowb8Tuple2 #-} - --- | Converts a 9-tuple into a 'Builder' with the given show functions. --- --- /Since: 3/ -liftShowb9Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f, TextShow g) - => (h -> Builder) -> (i -> Builder) - -> (a, b, c, d, e, f, g, h, i) -> Builder -liftShowb9Tuple2 = liftShowb2 -{-# INLINE liftShowb9Tuple2 #-} - --- | Converts a 10-tuple into a 'Builder' with the given show functions. --- --- /Since: 3/ -liftShowb10Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f, TextShow g, TextShow h) - => (i -> Builder) -> (j -> Builder) - -> (a, b, c, d, e, f, g, h, i, j) -> Builder -liftShowb10Tuple2 = liftShowb2 -{-# INLINE liftShowb10Tuple2 #-} - --- | Converts an 11-tuple into a 'Builder' with the given show functions. --- --- /Since: 3/ -liftShowb11Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, - TextShow f, TextShow g, TextShow h, TextShow i) - => (j -> Builder) -> (k -> Builder) - -> (a, b, c, d, e, f, g, h, i, j, k) -> Builder -liftShowb11Tuple2 = liftShowb2 -{-# INLINE liftShowb11Tuple2 #-} - --- | Converts a 12-tuple into a 'Builder' with the given show functions. --- --- /Since: 3/ -liftShowb12Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, - TextShow f, TextShow g, TextShow h, TextShow i, TextShow j) - => (k -> Builder) -> (l -> Builder) - -> (a, b, c, d, e, f, g, h, i, j, k, l) -> Builder -liftShowb12Tuple2 = liftShowb2 -{-# INLINE liftShowb12Tuple2 #-} - --- | Converts a 13-tuple into a 'Builder' with the given show functions. --- --- /Since: 3/ -liftShowb13Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f, - TextShow g, TextShow h, TextShow i, TextShow j, TextShow k) - => (l -> Builder) -> (m -> Builder) - -> (a, b, c, d, e, f, g, h, i, j, k, l, m) -> Builder -liftShowb13Tuple2 = liftShowb2 -{-# INLINE liftShowb13Tuple2 #-} - --- | Converts a 14-tuple into a 'Builder' with the given show functions. --- --- /Since: 3/ -liftShowb14Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f, - TextShow g, TextShow h, TextShow i, TextShow j, TextShow k, TextShow l) - => (m -> Builder) -> (n -> Builder) - -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -> Builder -liftShowb14Tuple2 = liftShowb2 -{-# INLINE liftShowb14Tuple2 #-} - --- | Converts a 15-tuple into a 'Builder' with the given show functions. --- --- /Since: 3/ -liftShowb15Tuple2 :: (TextShow a, TextShow b, TextShow c, TextShow d, TextShow e, TextShow f, TextShow g, - TextShow h, TextShow i, TextShow j, TextShow k, TextShow l, TextShow m) - => (n -> Builder) -> (o -> Builder) - -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -> Builder -liftShowb15Tuple2 = liftShowb2 -{-# INLINE liftShowb15Tuple2 #-} - --- | Like 'liftShowbPrec2', except precedence-agnostic. -liftShowb2 :: TextShow2 f => (a -> Builder) -> (b -> Builder) -> f a b -> Builder -liftShowb2 sp1 sp2 = liftShowbPrec2 (const sp1) undefined (const sp2) undefined 0 - -- The Great Pyramids of Template Haskell +-- | /Since: 2/ $(deriveTextShow ''()) +-- | /Since: 2/ $(deriveTextShow ''(,)) +-- | /Since: 2/ $(deriveTextShow ''(,,)) +-- | /Since: 2/ $(deriveTextShow ''(,,,)) +-- | /Since: 2/ $(deriveTextShow ''(,,,,)) +-- | /Since: 2/ $(deriveTextShow ''(,,,,,)) +-- | /Since: 2/ $(deriveTextShow ''(,,,,,,)) +-- | /Since: 2/ $(deriveTextShow ''(,,,,,,,)) +-- | /Since: 2/ $(deriveTextShow ''(,,,,,,,,)) +-- | /Since: 2/ $(deriveTextShow ''(,,,,,,,,,)) +-- | /Since: 2/ $(deriveTextShow ''(,,,,,,,,,,)) +-- | /Since: 2/ $(deriveTextShow ''(,,,,,,,,,,,)) +-- | /Since: 2/ $(deriveTextShow ''(,,,,,,,,,,,,)) +-- | /Since: 2/ $(deriveTextShow ''(,,,,,,,,,,,,,)) +-- | /Since: 2/ $(deriveTextShow ''(,,,,,,,,,,,,,,)) +-- | /Since: 2/ $(deriveTextShow1 ''(,)) +-- | /Since: 2/ $(deriveTextShow1 ''(,,)) +-- | /Since: 2/ $(deriveTextShow1 ''(,,,)) +-- | /Since: 2/ $(deriveTextShow1 ''(,,,,)) +-- | /Since: 2/ $(deriveTextShow1 ''(,,,,,)) +-- | /Since: 2/ $(deriveTextShow1 ''(,,,,,,)) +-- | /Since: 2/ $(deriveTextShow1 ''(,,,,,,,)) +-- | /Since: 2/ $(deriveTextShow1 ''(,,,,,,,,)) +-- | /Since: 2/ $(deriveTextShow1 ''(,,,,,,,,,)) +-- | /Since: 2/ $(deriveTextShow1 ''(,,,,,,,,,,)) +-- | /Since: 2/ $(deriveTextShow1 ''(,,,,,,,,,,,)) +-- | /Since: 2/ $(deriveTextShow1 ''(,,,,,,,,,,,,)) +-- | /Since: 2/ $(deriveTextShow1 ''(,,,,,,,,,,,,,)) +-- | /Since: 2/ $(deriveTextShow1 ''(,,,,,,,,,,,,,,)) +-- | /Since: 2/ $(deriveTextShow2 ''(,)) +-- | /Since: 2/ $(deriveTextShow2 ''(,,)) +-- | /Since: 2/ $(deriveTextShow2 ''(,,,)) +-- | /Since: 2/ $(deriveTextShow2 ''(,,,,)) +-- | /Since: 2/ $(deriveTextShow2 ''(,,,,,)) +-- | /Since: 2/ $(deriveTextShow2 ''(,,,,,,)) +-- | /Since: 2/ $(deriveTextShow2 ''(,,,,,,,)) +-- | /Since: 2/ $(deriveTextShow2 ''(,,,,,,,,)) +-- | /Since: 2/ $(deriveTextShow2 ''(,,,,,,,,,)) +-- | /Since: 2/ $(deriveTextShow2 ''(,,,,,,,,,,)) +-- | /Since: 2/ $(deriveTextShow2 ''(,,,,,,,,,,,)) +-- | /Since: 2/ $(deriveTextShow2 ''(,,,,,,,,,,,,)) +-- | /Since: 2/ $(deriveTextShow2 ''(,,,,,,,,,,,,,)) +-- | /Since: 2/ $(deriveTextShow2 ''(,,,,,,,,,,,,,,)) diff --git a/src/TextShow/Data/Type/Coercion.hs b/src/TextShow/Data/Type/Coercion.hs --- a/src/TextShow/Data/Type/Coercion.hs +++ b/src/TextShow/Data/Type/Coercion.hs @@ -8,42 +8,32 @@ #endif {-| Module: TextShow.Data.Type.Coercion -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' function for representational equality. -This module only exports functions if using @base-4.7.0.0@ or later. +'TextShow' instance for representational equality. +Only provided if using @base-4.7.0.0@ or later. /Since: 2/ -} -module TextShow.Data.Type.Coercion ( -#if !(MIN_VERSION_base(4,7,0)) - ) where -#else - showbCoercion - ) where +module TextShow.Data.Type.Coercion () where -import Data.Text.Lazy.Builder (Builder) -import Data.Type.Coercion (Coercion(..)) +#if MIN_VERSION_base(4,7,0) +import Data.Type.Coercion (Coercion) -import TextShow.Classes (TextShow(..), TextShow1(..)) +import TextShow.Classes (TextShow1(..)) import TextShow.TH.Internal (deriveTextShow, deriveTextShow2, makeLiftShowbPrec) --- | Convert a representational equality value to a 'Builder'. --- This function is only available with @base-4.7.0.0@ or later. --- --- /Since: 2/ -showbCoercion :: Coercion a b -> Builder -showbCoercion = showb -{-# INLINE showbCoercion #-} - +-- | /Since: 2/ $(deriveTextShow ''Coercion) +-- | /Since: 2/ instance TextShow1 (Coercion a) where liftShowbPrec = $(makeLiftShowbPrec ''Coercion) +-- | /Since: 2/ $(deriveTextShow2 ''Coercion) #endif diff --git a/src/TextShow/Data/Type/Equality.hs b/src/TextShow/Data/Type/Equality.hs --- a/src/TextShow/Data/Type/Equality.hs +++ b/src/TextShow/Data/Type/Equality.hs @@ -9,42 +9,47 @@ #endif {-| Module: TextShow.Data.Type.Equality -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' function for propositional equality. -This module only exports functions if using @base-4.7.0.0@ or later. +'TextShow' instance for propositional equality. +Only provided if using @base-4.7.0.0@ or later. /Since: 2/ -} -module TextShow.Data.Type.Equality ( -#if !(MIN_VERSION_base(4,7,0)) - ) where -#else - showbPropEquality - ) where +module TextShow.Data.Type.Equality () where -import Data.Text.Lazy.Builder (Builder) -import Data.Type.Equality ((:~:)(..)) +#if MIN_VERSION_base(4,7,0) +import Data.Type.Equality ((:~:)) +# if MIN_VERSION_base(4,10,0) +import Data.Type.Equality ((:~~:)) +# endif -import TextShow.Classes (TextShow(..), TextShow1(..)) +import TextShow.Classes (TextShow1(..)) import TextShow.TH.Internal (deriveTextShow, deriveTextShow2, makeLiftShowbPrec) --- | Convert a propositional equality value to a 'Builder'. --- This function is only available with @base-4.7.0.0@ or later. --- --- /Since: 2/ -showbPropEquality :: (a :~: b) -> Builder -showbPropEquality = showb -{-# INLINE showbPropEquality #-} - +-- | /Since: 2/ $(deriveTextShow ''(:~:)) +-- | /Since: 2/ instance TextShow1 ((:~:) a) where liftShowbPrec = $(makeLiftShowbPrec ''(:~:)) +-- | /Since: 2/ $(deriveTextShow2 ''(:~:)) + +# if MIN_VERSION_base(4,10,0) +-- | /Since: 3.6/ +$(deriveTextShow ''(:~~:)) + +-- | /Since: 3.6/ +instance TextShow1 ((:~~:) a) where + liftShowbPrec = $(makeLiftShowbPrec ''(:~~:)) + +-- | /Since: 3.6/ +$(deriveTextShow2 ''(:~~:)) +# endif #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 @@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE OverloadedStrings #-} @@ -7,103 +8,83 @@ {-# LANGUAGE PolyKinds #-} #endif +#if __GLASGOW_HASKELL__ >= 801 +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE TypeApplications #-} +#endif + {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Typeable -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' functions for data types in the @Typeable@ module. +'TextShow' instances for data types in the @Typeable@ module. /Since: 2/ -} -module TextShow.Data.Typeable ( - showbTyCon - , showbTypeRepPrec -#if MIN_VERSION_base(4,9,0) - , showbTrName - , showbModule -#endif - ) where +module TextShow.Data.Typeable () where -import Data.Monoid.Compat ((<>)) -import Data.Text.Lazy.Builder (Builder, fromString, singleton) -import Data.Typeable (TypeRep, typeRepArgs, typeRepTyCon) -#if MIN_VERSION_base(4,4,0) -import Data.Typeable.Internal (tyConName) -# if MIN_VERSION_base(4,8,0) -import Data.Typeable.Internal (typeRepKinds) +#if MIN_VERSION_base(4,10,0) +import Data.Monoid.Compat ((<>)) +import Data.Kind (Type) +import Data.Text.Lazy.Builder (Builder, fromString, singleton) +import Data.Type.Equality ((:~~:)(..)) + +import GHC.Exts (Char(..)) +import GHC.Prim (Addr#, (+#), eqChar#, indexCharOffAddr#) +import GHC.Types (Module(..), TrName(..), TyCon(..), isTrue#) + +import TextShow.Classes (TextShow(..), TextShow1(..), showbParen, showbSpace) +import TextShow.Data.Typeable.Utils (showbArgs, showbTuple) +import TextShow.Utils (isTupleString) + +import Type.Reflection (pattern App, pattern Con, pattern Con', pattern Fun, + SomeTypeRep(..), TypeRep, + eqTypeRep, tyConName, typeRep, typeRepTyCon) +#else /* !(MIN_VERSION_base(4,10,0) */ +import Data.Monoid.Compat ((<>)) +import Data.Text.Lazy.Builder (fromString, singleton) +import Data.Typeable (TypeRep, typeRepArgs, typeRepTyCon) +# if MIN_VERSION_base(4,4,0) +import Data.Typeable.Internal (tyConName) +# if MIN_VERSION_base(4,8,0) +import Data.Typeable.Internal (typeRepKinds) +# endif +# if MIN_VERSION_base(4,9,0) +import Data.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) +# endif + # if MIN_VERSION_base(4,9,0) -import Data.Typeable.Internal (Proxy(..), Typeable, TypeRep(TypeRep), typeRep) -import GHC.Exts (RuntimeRep(..), TYPE) +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 (funTc, listTc) +import Data.Typeable.Internal (TyCon) +# else +import Data.Typeable (TyCon) # endif -#else -import Data.Typeable (mkTyCon, tyConString, typeOf) -#endif -#if MIN_VERSION_base(4,9,0) -import GHC.Exts (Char(..)) -import GHC.Prim (Addr#, (+#), eqChar#, indexCharOffAddr#) -import GHC.Types (TyCon(..), TrName(..), Module(..), isTrue#) -#elif MIN_VERSION_base(4,4,0) -import Data.Typeable.Internal (TyCon) -#else -import Data.Typeable (TyCon) -#endif - -import TextShow.Classes (TextShow(..), showbParen, showbSpace) -import TextShow.Data.List () -import TextShow.Data.Typeable.Utils (showbArgs, showbTuple) -import TextShow.Utils (isTupleString) - -#include "inline.h" - --- | Convert a 'TypeRep' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbTypeRepPrec :: Int -> TypeRep -> Builder -showbTypeRepPrec p tyrep = - case tys of - [] -> showbTyCon tycon -#if MIN_VERSION_base(4,9,0) - [x@(TypeRep _ argCon _ _)] -#else - [x] -#endif - | tycon == tcList -> singleton '[' <> showb x <> singleton ']' -#if MIN_VERSION_base(4,9,0) - | tycon == tcTYPE && argCon == tc'Lifted -> singleton '*' - | tycon == tcTYPE && argCon == tc'Unlifted -> singleton '#' -#endif - [a,r] | tycon == tcFun -> showbParen (p > 8) $ - showbPrec 9 a - <> " -> " - <> showbPrec 8 r - xs | isTupleTyCon tycon -> showbTuple xs - | otherwise -> showbParen (p > 9) $ - showbPrec p tycon - <> showbSpace - <> showbArgs showbSpace -#if MIN_VERSION_base(4,8,0) - (kinds ++ tys) -#else - tys -#endif - where - tycon = typeRepTyCon tyrep - tys = typeRepArgs tyrep -#if MIN_VERSION_base(4,8,0) - kinds = typeRepKinds tyrep +import TextShow.Classes (TextShow(..), showbParen, showbSpace) +import TextShow.Data.List () +import TextShow.Data.Typeable.Utils (showbArgs, showbTuple) +import TextShow.Utils (isTupleString) #endif -#if MIN_VERSION_base(4,9,0) +#if !(MIN_VERSION_base(4,10,0)) +# if MIN_VERSION_base(4,9,0) tyConOf :: Typeable a => Proxy a -> TyCon tyConOf = typeRepTyCon . typeRep @@ -121,7 +102,7 @@ tc'Unlifted :: TyCon tc'Unlifted = tyConOf (Proxy :: Proxy 'PtrRepUnlifted) -#elif MIN_VERSION_base(4,4,0) +# elif MIN_VERSION_base(4,4,0) -- | The list 'TyCon'. tcList :: TyCon tcList = listTc @@ -129,7 +110,7 @@ -- | The function (@->@) 'TyCon'. tcFun :: TyCon tcFun = funTc -#else +# else -- | The list 'TyCon'. tcList :: TyCon tcList = typeRepTyCon $ typeOf [()] @@ -137,6 +118,7 @@ -- | The function (@->@) 'TyCon'. tcFun :: TyCon tcFun = mkTyCon "->" +# endif #endif -- | Does the 'TyCon' represent a tuple type constructor? @@ -144,33 +126,131 @@ isTupleTyCon = isTupleString . tyConString {-# INLINE isTupleTyCon #-} --- | Convert a 'TyCon' to a 'Builder'. +#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. -- +-- /Since: 3.6/ +instance TextShow SomeTypeRep where + showbPrec p (SomeTypeRep ty) = showbPrec p ty + +-- | Only available with @base-4.10.0.0@ or later. +-- +-- /Since: 3.6/ +instance TextShow (TypeRep (a :: k)) where + showbPrec = showbTypeable + +-- | Only available with @base-4.10.0.0@ or later. +-- +-- /Since: 3.6/ +instance TextShow1 TypeRep where + liftShowbPrec _ _ = showbTypeable + +showbTypeable :: Int -> TypeRep (a :: k) -> Builder +showbTypeable _ rep + | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = + singleton '*' + | isListTyCon tc, [ty] <- tys = + singleton '[' <> showb ty <> singleton ']' + | isTupleTyCon tc = + showbTuple tys + where (tc, tys) = splitApps rep +showbTypeable p (Con' tycon []) + = showbPrec p tycon +showbTypeable p (Con' tycon args) + = showbParen (p > 9) $ + showbPrec p tycon <> + showbSpace <> + showbArgs showbSpace args +showbTypeable p (Fun x r) + = showbParen (p > 8) $ + showbPrec 9 x <> " -> " <> showbPrec 8 r +showbTypeable p (App f x) + = showbParen (p > 9) $ + showbPrec 8 f <> + showbSpace <> + showbPrec 10 x + +splitApps :: TypeRep a -> (TyCon, [SomeTypeRep]) +splitApps = go [] + where + go :: [SomeTypeRep] -> TypeRep a -> (TyCon, [SomeTypeRep]) + go xs (Con tc) = (tc, xs) + go xs (App f x) = go (SomeTypeRep x : xs) f + go [] (Fun a b) = (funTyCon, [SomeTypeRep a, SomeTypeRep b]) + go _ (Fun _ _) = + errorWithoutStackTrace "Data.Typeable.Internal.splitApps: Impossible" + +funTyCon :: TyCon +funTyCon = typeRepTyCon (typeRep @(->)) + +isListTyCon :: TyCon -> Bool +isListTyCon tc = tc == typeRepTyCon (typeRep :: TypeRep [Int]) +#else +-- | Only available with @base-4.9@ or earlier. +-- -- /Since: 2/ -showbTyCon :: TyCon -> Builder -#if MIN_VERSION_base(4,9,0) -showbTyCon (TyCon _ _ _ tc_name) = showb tc_name +instance TextShow TypeRep where + showbPrec p tyrep = + case tys of + [] -> showb tycon +# if MIN_VERSION_base(4,9,0) + [x@(TypeRep _ argCon _ _)] +# else + [x] +# endif + | tycon == tcList -> singleton '[' <> showb x <> singleton ']' +# if MIN_VERSION_base(4,9,0) + | tycon == tcTYPE && argCon == tc'Lifted -> singleton '*' + | tycon == tcTYPE && argCon == tc'Unlifted -> singleton '#' +# endif + [a,r] | tycon == tcFun -> showbParen (p > 8) $ + showbPrec 9 a + <> " -> " + <> showbPrec 8 r + xs | isTupleTyCon tycon -> showbTuple xs + | otherwise -> showbParen (p > 9) $ + showbPrec p tycon + <> showbSpace + <> showbArgs showbSpace +# if MIN_VERSION_base(4,8,0) + (kinds ++ tys) +# else + tys +# endif + where + tycon = typeRepTyCon tyrep + tys = typeRepArgs tyrep +# if MIN_VERSION_base(4,8,0) + kinds = typeRepKinds tyrep +# endif +#endif + +-- | /Since: 2/ +instance TextShow TyCon where +#if MIN_VERSION_base(4,10,0) + showbPrec p (TyCon _ _ _ tc_name _ _) = showbPrec p tc_name +#elif MIN_VERSION_base(4,9,0) + showb (TyCon _ _ _ tc_name) = showb tc_name #else -showbTyCon = fromString . tyConString + showb = fromString . tyConString #endif -{-# INLINE showbTyCon #-} #if MIN_VERSION_base(4,9,0) --- | Convert a 'TrName' to a 'Builder'. --- This function is only available with @base-4.9.0.0@ or later. --- --- /Since: 3/ -showbTrName :: TrName -> Builder -showbTrName (TrNameS s) = unpackCStringToBuilder# s -showbTrName (TrNameD s) = fromString s - --- | Convert a 'Module' to a 'Builder'. --- This function is only available with @base-4.9.0.0@ or later. +-- | Only available with @base-4.9.0.0@ or later. -- -- /Since: 3/ -showbModule :: Module -> Builder -showbModule (Module p m) = showb p <> singleton ':' <> showb m -{-# INLINE showbModule #-} +instance TextShow TrName where + showb (TrNameS s) = unpackCStringToBuilder# s + showb (TrNameD s) = fromString s + {-# INLINE showb #-} unpackCStringToBuilder# :: Addr# -> Builder -- There's really no point in inlining this, ever, as the loop doesn't @@ -185,30 +265,11 @@ where !ch = indexCharOffAddr# addr nh {-# NOINLINE unpackCStringToBuilder# #-} -#endif -#if MIN_VERSION_base(4,4,0) --- | Identical to 'tyConName'. Defined to avoid using excessive amounts of pragmas --- with base-4.3 and earlier, which use 'tyConString'. -tyConString :: TyCon -> String -tyConString = tyConName -{-# INLINE tyConString #-} -#endif - -instance TextShow TypeRep where - showbPrec = showbTypeRepPrec - INLINE_INST_FUN(showbPrec) - -instance TextShow TyCon where - showb = showbTyCon - INLINE_INST_FUN(showb) - -#if MIN_VERSION_base(4,9,0) -instance TextShow TrName where - showb = showbTrName - INLINE_INST_FUN(showb) - +-- | Only available with @base-4.9.0.0@ or later. +-- +-- /Since: 3/ instance TextShow Module where - showb = showbModule - INLINE_INST_FUN(showb) + showb (Module p m) = showb p <> singleton ':' <> showb m + {-# INLINE showb #-} #endif diff --git a/src/TextShow/Data/Typeable/Utils.hs b/src/TextShow/Data/Typeable/Utils.hs --- a/src/TextShow/Data/Typeable/Utils.hs +++ b/src/TextShow/Data/Typeable/Utils.hs @@ -1,6 +1,6 @@ {-| Module: TextShow.Data.Typeable.Utils -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional diff --git a/src/TextShow/Data/Version.hs b/src/TextShow/Data/Version.hs --- a/src/TextShow/Data/Version.hs +++ b/src/TextShow/Data/Version.hs @@ -2,20 +2,17 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Version -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' functions for 'Version'. +Provides a 'TextShow' instance for 'Version' and the 'showbVersion' function. /Since: 2/ -} -module TextShow.Data.Version ( - showbVersionPrec - , showbVersionConcrete - ) where +module TextShow.Data.Version (showbVersion) where import Data.List (intersperse) import Data.Monoid.Compat ((<>)) @@ -25,28 +22,22 @@ import Prelude () import Prelude.Compat -import TextShow.Classes (showb, showbPrec) +import TextShow.Classes (TextShow(..)) import TextShow.Data.Char () import TextShow.Data.Integral () import TextShow.Data.List () import TextShow.TH.Internal (deriveTextShow) --- | Convert a 'Version' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbVersionPrec :: Int -> Version -> Builder -showbVersionPrec = showbPrec -{-# INLINE showbVersionPrec #-} - -- | Provides one possible concrete representation for 'Version'. For -- a version with 'versionBranch' @= [1,2,3]@ and 'versionTags' -- @= [\"tag1\",\"tag2\"]@, the output will be @1.2.3-tag1-tag2@. -- --- /Since: 2/ -showbVersionConcrete :: Version -> Builder -showbVersionConcrete (Version branch tags) +-- /Since: 3.6/ +showbVersion :: Version -> Builder +showbVersion (Version branch tags) = mconcat (intersperse (singleton '.') $ map showb branch) <> mconcat (map ((singleton '-' <>) . fromString) tags) -{-# INLINE showbVersionConcrete #-} +{-# INLINE showbVersion #-} +-- | /Since: 2/ $(deriveTextShow ''Version) diff --git a/src/TextShow/Data/Void.hs b/src/TextShow/Data/Void.hs --- a/src/TextShow/Data/Void.hs +++ b/src/TextShow/Data/Void.hs @@ -1,31 +1,22 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Data.Void -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' function for 'Void' values. +'TextShow' instance for 'Void'. /Since: 2/ -} -module TextShow.Data.Void (showbVoid) where +module TextShow.Data.Void () where -import Data.Text.Lazy.Builder (Builder) import Data.Void (Void, absurd) - import Prelude () - import TextShow.Classes (TextShow(..)) --- | Since 'Void' values logically don't exist, attempting to convert one to a --- 'Builder' will never terminate. --- --- /Since: 2/ -showbVoid :: Void -> Builder -showbVoid = absurd - +-- | /Since: 2/ instance TextShow Void where - showb = showbVoid + showb = absurd 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 @@ -3,7 +3,7 @@ {-# LANGUAGE OverloadedStrings #-} {-| Module: TextShow.Debug.Trace -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional diff --git a/src/TextShow/Debug/Trace/Generic.hs b/src/TextShow/Debug/Trace/Generic.hs --- a/src/TextShow/Debug/Trace/Generic.hs +++ b/src/TextShow/Debug/Trace/Generic.hs @@ -2,7 +2,7 @@ {-| Module: TextShow.Debug.Trace.Generic -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional diff --git a/src/TextShow/Debug/Trace/TH.hs b/src/TextShow/Debug/Trace/TH.hs --- a/src/TextShow/Debug/Trace/TH.hs +++ b/src/TextShow/Debug/Trace/TH.hs @@ -1,7 +1,7 @@ {-# LANGUAGE TemplateHaskell #-} {-| Module: TextShow.Debug.Trace.TH -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional 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 @@ -6,48 +6,18 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Foreign.C.Types -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' functions for Haskell newtypes corresponding to C +'TextShow' instances for Haskell newtypes corresponding to C types in the Foreign Function Interface (FFI). /Since: 2/ -} -module TextShow.Foreign.C.Types ( - showbCCharPrec - , showbCSCharPrec - , showbCUChar - , showbCShortPrec - , showbCUShort - , showbCIntPrec - , showbCUInt - , showbCLongPrec - , showbCULong - , showbCPtrdiffPrec - , showbCSize - , showbCWcharPrec - , showbCSigAtomicPrec - , showbCLLongPrec - , showbCULLong - , showbCIntPtrPrec - , showbCUIntPtr - , showbCIntMaxPrec - , showbCUIntMax - , showbCClockPrec - , showbCTimePrec -#if MIN_VERSION_base(4,4,0) - , showbCUSeconds - , showbCSUSecondsPrec -#endif - , showbCFloatPrec - , showbCDoublePrec - ) where - -import Data.Text.Lazy.Builder (Builder) +module TextShow.Foreign.C.Types () where import Foreign.C.Types @@ -57,421 +27,180 @@ #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" -# include "inline.h" #endif --- | Convert a 'CChar' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbCCharPrec :: Int -> CChar -> Builder #if MIN_VERSION_base(4,5,0) -showbCCharPrec = showbPrec -{-# INLINE showbCCharPrec #-} -#else -showbCCharPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_CHAR -> Builder) -#endif - --- | Convert a 'CSChar' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbCSCharPrec :: Int -> CSChar -> Builder -#if MIN_VERSION_base(4,5,0) -showbCSCharPrec = showbPrec -{-# INLINE showbCSCharPrec #-} -#else -showbCSCharPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_SIGNED_CHAR -> Builder) -#endif - --- | Convert a 'CUChar' to a 'Builder'. --- --- /Since: 2/ -showbCUChar :: CUChar -> Builder -#if MIN_VERSION_base(4,5,0) -showbCUChar = showb -{-# INLINE showbCUChar #-} -#else -showbCUChar = unsafeCoerce (showb :: HTYPE_UNSIGNED_CHAR -> Builder) -#endif - --- | Convert a 'CShort' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbCShortPrec :: Int -> CShort -> Builder -#if MIN_VERSION_base(4,5,0) -showbCShortPrec = showbPrec -{-# INLINE showbCShortPrec #-} -#else -showbCShortPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_SHORT -> Builder) -#endif - --- | Convert a 'CUShort' to a 'Builder'. --- --- /Since: 2/ -showbCUShort :: CUShort -> Builder -#if MIN_VERSION_base(4,5,0) -showbCUShort = showb -{-# INLINE showbCUShort #-} -#else -showbCUShort = unsafeCoerce (showb :: HTYPE_UNSIGNED_SHORT -> Builder) -#endif - --- | Convert a 'CInt' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbCIntPrec :: Int -> CInt -> Builder -#if MIN_VERSION_base(4,5,0) -showbCIntPrec = showbPrec -{-# INLINE showbCIntPrec #-} -#else -showbCIntPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_INT -> Builder) -#endif - --- | Convert a 'CUInt' to a 'Builder'. --- --- /Since: 2/ -showbCUInt :: CUInt -> Builder -#if MIN_VERSION_base(4,5,0) -showbCUInt = showb -{-# INLINE showbCUInt #-} -#else -showbCUInt = unsafeCoerce (showb :: HTYPE_UNSIGNED_INT -> Builder) -#endif - --- | Convert a 'CLong' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbCLongPrec :: Int -> CLong -> Builder -#if MIN_VERSION_base(4,5,0) -showbCLongPrec = showbPrec -{-# INLINE showbCLongPrec #-} -#else -showbCLongPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_LONG -> Builder) -#endif - --- | Convert a 'CULong' to a 'Builder'. --- --- /Since: 2/ -showbCULong :: CULong -> Builder -#if MIN_VERSION_base(4,5,0) -showbCULong = showb -{-# INLINE showbCULong #-} -#else -showbCULong = unsafeCoerce (showb :: HTYPE_UNSIGNED_LONG -> Builder) -#endif - --- | Convert a 'CPtrdiff' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbCPtrdiffPrec :: Int -> CPtrdiff -> Builder -#if MIN_VERSION_base(4,5,0) -showbCPtrdiffPrec = showbPrec -{-# INLINE showbCPtrdiffPrec #-} -#else -showbCPtrdiffPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_PTRDIFF_T -> Builder) -#endif - --- | Convert a 'CSize' to a 'Builder'. --- --- /Since: 2/ -showbCSize :: CSize -> Builder -#if MIN_VERSION_base(4,5,0) -showbCSize = showb -{-# INLINE showbCSize #-} -#else -showbCSize = unsafeCoerce (showb :: HTYPE_SIZE_T -> Builder) -#endif - --- | Convert a 'CWchar' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbCWcharPrec :: Int -> CWchar -> Builder -#if MIN_VERSION_base(4,5,0) -showbCWcharPrec = showbPrec -{-# INLINE showbCWcharPrec #-} -#else -showbCWcharPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_WCHAR_T -> Builder) -#endif - --- | Convert a 'CSigAtomic' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbCSigAtomicPrec :: Int -> CSigAtomic -> Builder -#if MIN_VERSION_base(4,5,0) -showbCSigAtomicPrec = showbPrec -{-# INLINE showbCSigAtomicPrec #-} -#else -showbCSigAtomicPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_SIG_ATOMIC_T -> Builder) -#endif - --- | Convert a 'CLLong' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbCLLongPrec :: Int -> CLLong -> Builder -#if MIN_VERSION_base(4,5,0) -showbCLLongPrec = showbPrec -{-# INLINE showbCLLongPrec #-} -#else -showbCLLongPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_LONG_LONG -> Builder) -#endif - --- | Convert a 'CULLong' to a 'Builder'. --- --- /Since: 2/ -showbCULLong :: CULLong -> Builder -#if MIN_VERSION_base(4,5,0) -showbCULLong = showb -{-# INLINE showbCULLong #-} -#else -showbCULLong = unsafeCoerce (showb :: HTYPE_UNSIGNED_LONG_LONG -> Builder) -#endif - --- | Convert a 'CIntPtr' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbCIntPtrPrec :: Int -> CIntPtr -> Builder -#if MIN_VERSION_base(4,5,0) -showbCIntPtrPrec = showbPrec -{-# INLINE showbCIntPtrPrec #-} -#else -showbCIntPtrPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_INTPTR_T -> Builder) -#endif - --- | Convert a 'CUIntPtr' to a 'Builder'. --- --- /Since: 2/ -showbCUIntPtr :: CUIntPtr -> Builder -#if MIN_VERSION_base(4,5,0) -showbCUIntPtr = showb -{-# INLINE showbCUIntPtr #-} -#else -showbCUIntPtr = unsafeCoerce (showb :: HTYPE_UINTPTR_T -> Builder) -#endif - --- | Convert a 'CIntMax' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbCIntMaxPrec :: Int -> CIntMax -> Builder -#if MIN_VERSION_base(4,5,0) -showbCIntMaxPrec = showbPrec -{-# INLINE showbCIntMaxPrec #-} -#else -showbCIntMaxPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_INTMAX_T -> Builder) -#endif - --- | Convert a 'CUIntMax' to a 'Builder'. --- --- /Since: 2/ -showbCUIntMax :: CUIntMax -> Builder -#if MIN_VERSION_base(4,5,0) -showbCUIntMax = showb -{-# INLINE showbCUIntMax #-} -#else -showbCUIntMax = unsafeCoerce (showb :: HTYPE_UINTMAX_T -> Builder) -#endif - --- | Convert a 'CClock' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbCClockPrec :: Int -> CClock -> Builder -#if MIN_VERSION_base(4,5,0) -showbCClockPrec = showbPrec -{-# INLINE showbCClockPrec #-} -#else -showbCClockPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_CLOCK_T -> Builder) -#endif - --- | Convert a 'CTime' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbCTimePrec :: Int -> CTime -> Builder -#if MIN_VERSION_base(4,5,0) -showbCTimePrec = showbPrec -{-# INLINE showbCTimePrec #-} -#else -showbCTimePrec = unsafeCoerce (showbPrec :: Int -> HTYPE_TIME_T -> Builder) -#endif - -#if MIN_VERSION_base(4,4,0) --- | Convert a 'CUSeconds' value to a 'Builder'. --- This function is only available with @base-4.4.0.0@ or later. --- --- /Since: 2/ -showbCUSeconds :: CUSeconds -> Builder -# if MIN_VERSION_base(4,5,0) -showbCUSeconds = showb -{-# INLINE showbCUSeconds #-} -# else -showbCUSeconds = unsafeCoerce (showb :: HTYPE_USECONDS_T -> Builder) -# endif - --- | Convert a 'CSUSeconds' value to a 'Builder' with the given precedence. --- This function is only available with @base-4.4.0.0@ or later. --- --- /Since: 2/ -showbCSUSecondsPrec :: Int -> CSUSeconds -> Builder -# if MIN_VERSION_base(4,5,0) -showbCSUSecondsPrec = showbPrec -{-# INLINE showbCSUSecondsPrec #-} -# else -showbCSUSecondsPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_SUSECONDS_T -> Builder) -# endif -#endif - --- | Convert a 'CFloat' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbCFloatPrec :: Int -> CFloat -> Builder -#if MIN_VERSION_base(4,5,0) -showbCFloatPrec = showbPrec -{-# INLINE showbCFloatPrec #-} -#else -showbCFloatPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_FLOAT -> Builder) -#endif - --- | Convert a 'CDouble' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbCDoublePrec :: Int -> CDouble -> Builder -#if MIN_VERSION_base(4,5,0) -showbCDoublePrec = showbPrec -{-# INLINE showbCDoublePrec #-} -#else -showbCDoublePrec = unsafeCoerce (showbPrec :: Int -> HTYPE_DOUBLE -> Builder) -#endif - -#if MIN_VERSION_base(4,5,0) +-- | /Since: 2/ deriving instance TextShow CChar +-- | /Since: 2/ deriving instance TextShow CSChar +-- | /Since: 2/ deriving instance TextShow CUChar +-- | /Since: 2/ deriving instance TextShow CShort +-- | /Since: 2/ deriving instance TextShow CUShort +-- | /Since: 2/ deriving instance TextShow CInt +-- | /Since: 2/ deriving instance TextShow CUInt +-- | /Since: 2/ deriving instance TextShow CLong +-- | /Since: 2/ deriving instance TextShow CULong +-- | /Since: 2/ deriving instance TextShow CPtrdiff +-- | /Since: 2/ deriving instance TextShow CSize +-- | /Since: 2/ deriving instance TextShow CWchar +-- | /Since: 2/ deriving instance TextShow CSigAtomic +-- | /Since: 2/ deriving instance TextShow CLLong +-- | /Since: 2/ deriving instance TextShow CULLong +-- | /Since: 2/ deriving instance TextShow CIntPtr +-- | /Since: 2/ deriving instance TextShow CUIntPtr +-- | /Since: 2/ deriving instance TextShow CIntMax +-- | /Since: 2/ deriving instance TextShow CUIntMax +-- | /Since: 2/ deriving instance TextShow CClock +-- | /Since: 2/ deriving instance TextShow CTime -# if MIN_VERSION_base(4,4,0) +-- | Only available with @base-4.4.0.0@ or later. +-- +-- /Since: 2/ deriving instance TextShow CUSeconds +-- | Only available with @base-4.4.0.0@ or later. +-- +-- /Since: 2/ deriving instance TextShow CSUSeconds -# endif +-- | /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. +-- +-- /Since: 3.6/ +deriving instance TextShow CBool +# endif #else +-- | /Since: 2/ instance TextShow CChar where - showbPrec = showbCCharPrec - INLINE_INST_FUN(showbPrec) + showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_CHAR -> Builder) +-- | /Since: 2/ instance TextShow CSChar where - showbPrec = showbCSCharPrec - INLINE_INST_FUN(showbPrec) + showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_SIGNED_CHAR -> Builder) +-- | /Since: 2/ instance TextShow CUChar where - showb = showbCUChar - INLINE_INST_FUN(showb) + showb = unsafeCoerce (showb :: HTYPE_UNSIGNED_CHAR -> Builder) +-- | /Since: 2/ instance TextShow CShort where - showbPrec = showbCShortPrec - INLINE_INST_FUN(showbPrec) + showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_SHORT -> Builder) +-- | /Since: 2/ instance TextShow CUShort where - showb = showbCUShort - INLINE_INST_FUN(showb) + showb = unsafeCoerce (showb :: HTYPE_UNSIGNED_SHORT -> Builder) +-- | /Since: 2/ instance TextShow CInt where - showbPrec = showbCIntPrec - INLINE_INST_FUN(showbPrec) + showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_INT -> Builder) +-- | /Since: 2/ instance TextShow CUInt where - showb = showbCUInt - INLINE_INST_FUN(showb) + showb = unsafeCoerce (showb :: HTYPE_UNSIGNED_INT -> Builder) +-- | /Since: 2/ instance TextShow CLong where - showbPrec = showbCLongPrec - INLINE_INST_FUN(showbPrec) + showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_LONG -> Builder) +-- | /Since: 2/ instance TextShow CULong where - showb = showbCULong - INLINE_INST_FUN(showb) + showb = unsafeCoerce (showb :: HTYPE_UNSIGNED_LONG -> Builder) +-- | /Since: 2/ instance TextShow CPtrdiff where - showbPrec = showbCPtrdiffPrec - INLINE_INST_FUN(showbPrec) + showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_PTRDIFF_T -> Builder) +-- | /Since: 2/ instance TextShow CSize where - showb = showbCSize - INLINE_INST_FUN(showb) + showb = unsafeCoerce (showb :: HTYPE_SIZE_T -> Builder) +-- | /Since: 2/ instance TextShow CWchar where - showbPrec = showbCWcharPrec - INLINE_INST_FUN(showbPrec) + showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_WCHAR_T -> Builder) +-- | /Since: 2/ instance TextShow CSigAtomic where - showbPrec = showbCSigAtomicPrec - INLINE_INST_FUN(showbPrec) + showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_SIG_ATOMIC_T -> Builder) +-- | /Since: 2/ instance TextShow CLLong where - showbPrec = showbCLLongPrec - INLINE_INST_FUN(showbPrec) + showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_LONG_LONG -> Builder) +-- | /Since: 2/ instance TextShow CULLong where - showb = showbCULLong - INLINE_INST_FUN(showb) + showb = unsafeCoerce (showb :: HTYPE_UNSIGNED_LONG_LONG -> Builder) +-- | /Since: 2/ instance TextShow CIntPtr where - showbPrec = showbCIntPtrPrec - INLINE_INST_FUN(showbPrec) + showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_INTPTR_T -> Builder) +-- | /Since: 2/ instance TextShow CUIntPtr where - showb = showbCUIntPtr - INLINE_INST_FUN(showb) + showb = unsafeCoerce (showb :: HTYPE_UINTPTR_T -> Builder) +-- | /Since: 2/ instance TextShow CIntMax where - showbPrec = showbCIntMaxPrec - INLINE_INST_FUN(showbPrec) + showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_INTMAX_T -> Builder) +-- | /Since: 2/ instance TextShow CUIntMax where - showb = showbCUIntMax - INLINE_INST_FUN(showb) + showb = unsafeCoerce (showb :: HTYPE_UINTMAX_T -> Builder) +-- | /Since: 2/ instance TextShow CClock where - showbPrec = showbCClockPrec - INLINE_INST_FUN(showbPrec) + showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_CLOCK_T -> Builder) +-- | /Since: 2/ instance TextShow CTime where - showbPrec = showbCTimePrec - INLINE_INST_FUN(showbPrec) + 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 = showbCUSeconds - INLINE_INST_FUN(showb) + showb = unsafeCoerce (showb :: HTYPE_USECONDS_T -> Builder) +-- | Only available with @base-4.4.0.0@ or later. +-- +-- /Since: 2/ instance TextShow CSUSeconds where - showbPrec = showbCSUSecondsPrec - INLINE_INST_FUN(showbPrec) + showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_SUSECONDS_T -> Builder) # endif +-- | /Since: 2/ instance TextShow CFloat where - showbPrec = showbCFloatPrec - INLINE_INST_FUN(showbPrec) + showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_FLOAT -> Builder) +-- | /Since: 2/ instance TextShow CDouble where - showbPrec = showbCDoublePrec - INLINE_INST_FUN(showbPrec) + showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_DOUBLE -> Builder) #endif diff --git a/src/TextShow/Foreign/Ptr.hs b/src/TextShow/Foreign/Ptr.hs --- a/src/TextShow/Foreign/Ptr.hs +++ b/src/TextShow/Foreign/Ptr.hs @@ -3,24 +3,18 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Foreign.Ptr -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' functions for pointer types used in the Haskell +'TextShow' instances for pointer types used in the Haskell Foreign Function Interface (FFI). /Since: 2/ -} -module TextShow.Foreign.Ptr ( - showbPtr - , showbFunPtr - , showbIntPtrPrec - , showbWordPtr - , showbForeignPtr - ) where +module TextShow.Foreign.Ptr () where import Data.Monoid.Compat ((<>)) import Data.Semigroup (mtimesDefault) @@ -32,55 +26,25 @@ import GHC.ForeignPtr (unsafeForeignPtrToPtr) import GHC.Num (wordToInteger) import GHC.Ptr (Ptr(..)) -import GHC.Prim (addr2Int#, int2Word#, unsafeCoerce#) +import GHC.Prim (addr2Int#, int2Word#) +import Prelude () +import Prelude.Compat + import TextShow.Classes (TextShow(..), TextShow1(..)) -import TextShow.Data.Integral (showbHex, showbIntPrec, showbWord) +import TextShow.Data.Integral (showbHex) import TextShow.Utils (lengthB) -#include "MachDeps.h" -#include "inline.h" - --- | Convert a 'Ptr' to a 'Builder'. Note that this does not require the parameterized --- type to be an instance of 'Show' itself. --- --- /Since: 2/ -showbPtr :: Ptr a -> Builder -showbPtr = showb -{-# INLINE showbPtr #-} - --- | Convert a 'FunPtr' to a 'Builder'. Note that this does not require the --- parameterized type to be an instance of 'Show' itself. --- --- /Since: 2/ -showbFunPtr :: FunPtr a -> Builder -showbFunPtr = showb -{-# INLINE showbFunPtr #-} - --- | Convert an 'IntPtr' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbIntPtrPrec :: Int -> IntPtr -> Builder -showbIntPtrPrec p ip = showbIntPrec p $ unsafeCoerce# ip - --- | Convert a 'WordPtr' to a 'Builder'. --- --- /Since: 2/ -showbWordPtr :: WordPtr -> Builder -showbWordPtr wp = showbWord $ unsafeCoerce# wp +import Unsafe.Coerce (unsafeCoerce) --- | Convert a 'ForeignPtr' to a 'Builder'. Note that this does not require the --- parameterized type to be an instance of 'Show' itself. --- --- /Since: 2/ -showbForeignPtr :: ForeignPtr a -> Builder -showbForeignPtr = showb -{-# INLINE showbForeignPtr #-} +#include "MachDeps.h" +-- | /Since: 2/ instance TextShow (Ptr a) where showbPrec = liftShowbPrec undefined undefined - INLINE_INST_FUN(showbPrec) + {-# INLINE showbPrec #-} +-- | /Since: 2/ instance TextShow1 Ptr where liftShowbPrec _ _ _ (Ptr a) = padOut . showbHex $ wordToInteger (int2Word# (addr2Int# a)) where @@ -90,26 +54,30 @@ <> mtimesDefault (max 0 $ 2*SIZEOF_HSPTR - lengthB ls) (singleton '0') <> ls +-- | /Since: 2/ instance TextShow (FunPtr a) where showbPrec = liftShowbPrec undefined undefined - INLINE_INST_FUN(showbPrec) + {-# INLINE showbPrec #-} +-- | /Since: 2/ instance TextShow1 FunPtr where liftShowbPrec _ _ _ = showb . castFunPtrToPtr - INLINE_INST_FUN(liftShowbPrec) + {-# INLINE liftShowbPrec #-} +-- | /Since: 2/ instance TextShow IntPtr where - showbPrec = showbIntPtrPrec - INLINE_INST_FUN(showbPrec) + showbPrec p ip = showbPrec p (unsafeCoerce ip :: Integer) +-- | /Since: 2/ instance TextShow WordPtr where - showb = showbWordPtr - INLINE_INST_FUN(showb) + showb wp = showb (unsafeCoerce wp :: Word) +-- | /Since: 2/ instance TextShow (ForeignPtr a) where showbPrec = liftShowbPrec undefined undefined - INLINE_INST_FUN(showbPrec) + {-# INLINE showbPrec #-} +-- | /Since: 2/ instance TextShow1 ForeignPtr where liftShowbPrec _ _ _ = showb . unsafeForeignPtrToPtr - INLINE_INST_FUN(liftShowbPrec) + {-# INLINE liftShowbPrec #-} diff --git a/src/TextShow/FromStringTextShow.hs b/src/TextShow/FromStringTextShow.hs --- a/src/TextShow/FromStringTextShow.hs +++ b/src/TextShow/FromStringTextShow.hs @@ -32,7 +32,7 @@ {-| Module: TextShow.FromStringTextShow -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional diff --git a/src/TextShow/Functions.hs b/src/TextShow/Functions.hs --- a/src/TextShow/Functions.hs +++ b/src/TextShow/Functions.hs @@ -1,40 +1,32 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Functions -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Optional 'TextShow', 'TextShow1', and 'TextShow2' instances for functions. +Optional orphan 'TextShow', 'TextShow1', and 'TextShow2' instances for functions. /Since: 2/ -} -module TextShow.Functions (showbFunction) where +module TextShow.Functions () where -import Data.Text.Lazy.Builder (Builder) import TextShow.Classes (TextShow(..), TextShow1(..), TextShow2(..)) -#include "inline.h" - --- | Convert a function to a 'Builder'. --- --- /Since: 2/ -showbFunction :: (a -> b) -> Builder -showbFunction = showb -{-# INLINE showbFunction #-} - +-- | /Since: 2/ instance TextShow (a -> b) where showbPrec = liftShowbPrec undefined undefined - INLINE_INST_FUN(showbPrec) + {-# INLINE showbPrec #-} +-- | /Since: 2/ instance TextShow1 ((->) a) where liftShowbPrec = liftShowbPrec2 undefined undefined - INLINE_INST_FUN(liftShowbPrec) + {-# INLINE liftShowbPrec #-} +-- | /Since: 2/ instance TextShow2 (->) where liftShowbPrec2 _ _ _ _ _ _ = "" - INLINE_INST_FUN(liftShowbPrec2) + {-# INLINE liftShowbPrec2 #-} diff --git a/src/TextShow/GHC/Conc/Windows.hs b/src/TextShow/GHC/Conc/Windows.hs --- a/src/TextShow/GHC/Conc/Windows.hs +++ b/src/TextShow/GHC/Conc/Windows.hs @@ -6,37 +6,23 @@ #endif {-| Module: TextShow.GHC.Conc.Windows -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' function for 'ConsoleEvent'. -This module only exports functions if using Windows, and not using GHCJS. +'TextShow' instance for 'ConsoleEvent'. +Only provided if using Windows, and not using GHCJS. /Since: 2/ -} -module TextShow.GHC.Conc.Windows ( -#if defined(__GHCJS__) || !defined(mingw32_HOST_OS) - ) where -#else - showbConsoleEvent - ) where - -import Data.Text.Lazy.Builder (Builder) +module TextShow.GHC.Conc.Windows () where +#if !defined(__GHCJS__) && defined(mingw32_HOST_OS) import GHC.Conc.Windows (ConsoleEvent) - -import TextShow.Classes (showb) import TextShow.TH.Internal (deriveTextShow) --- | Convert a 'ConsoleEvent' to a 'Builder'. --- --- /Since: 2/ -showbConsoleEvent :: ConsoleEvent -> Builder -showbConsoleEvent = showb -{-# INLINE showbConsoleEvent #-} - +-- | /Since: 2/ $(deriveTextShow ''ConsoleEvent) #endif 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 @@ -7,35 +7,27 @@ #endif {-| Module: TextShow.GHC.Event -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' functions for data types in the @Event@ module. -This module only exports functions if using @base-4.4.0.0@ on a platform other +'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. /Since: 2/ -} -module TextShow.GHC.Event ( -#if defined(__GHCJS__) || defined(mingw32_HOST_OS) || !(MIN_VERSION_base(4,4,0)) - ) where -#else - showbEvent - , showbFdKeyPrec -# if MIN_VERSION_base(4,8,1) - , showbLifetime -# endif - ) where +module TextShow.GHC.Event () where +#if !defined(__GHCJS__) && !defined(mingw32_HOST_OS) && MIN_VERSION_base(4,4,0) import Data.List (intersperse) import Data.Maybe (catMaybes) import Data.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (Builder, singleton) -import GHC.Event (Event, FdKey, evtRead, evtWrite) +import GHC.Event (Event, evtRead, evtWrite) import Language.Haskell.TH.Lib (conT, varE) @@ -53,55 +45,29 @@ import GHC.Event (Lifetime) # endif -#include "inline.h" - --- | Convert an 'Event' to a 'Builder'. --- This function is only available with @base-4.4.0.0@ or later and is not available --- on Windows. --- --- /Since: 2/ -showbEvent :: Event -> Builder -showbEvent e = singleton '[' <> mconcat (intersperse "," $ catMaybes - [ evtRead `so` "evtRead" - , evtWrite `so` "evtWrite" - , $(varE evtCloseValName) `so` "evtClose" - ]) <> singleton ']' - where - so :: Event -> Builder -> Maybe Builder - ev `so` disp | $(varE eventIsValName) e ev = Just disp - | otherwise = Nothing - --- | Convert an 'FdKey' to a 'Builder' with the given precedence. --- This function is only available with @base-4.4.0.0@ or later and is not available --- on Windows. --- --- /Since: 2/ -showbFdKeyPrec :: Int -> FdKey -> Builder -showbFdKeyPrec = showbPrec -{-# INLINE showbFdKeyPrec #-} - -# if MIN_VERSION_base(4,8,1) --- | Convert a 'Lifetime' to a 'Builder'. --- This function is only available with @base-4.8.1.0@ or later and is not available --- on Windows. --- --- /Since: 2/ -showbLifetime :: Lifetime -> Builder -showbLifetime = showb -{-# INLINE showbLifetime #-} -# endif - +-- | /Since: 2/ instance TextShow Event where - showb = showbEvent - {-# INLINE showb #-} + showb e = singleton '[' <> mconcat (intersperse "," $ catMaybes + [ evtRead `so` "evtRead" + , evtWrite `so` "evtWrite" + , $(varE evtCloseValName) `so` "evtClose" + ]) <> singleton ']' + where + so :: Event -> Builder -> Maybe Builder + ev `so` disp | $(varE eventIsValName) e ev = Just disp + | otherwise = Nothing +-- | /Since: 2/ $(deriveTextShow fdKeyTypeName) instance TextShow $(conT uniqueTypeName) where showb = showb . $(varE asInt64ValName) - INLINE_INST_FUN(showb) + {-# INLINE showb #-} # if MIN_VERSION_base(4,8,1) +-- | Only available with @base-4.8.1.0@ or later. +-- +-- /Since: 2/ $(deriveTextShow ''Lifetime) # endif #endif diff --git a/src/TextShow/GHC/Fingerprint.hs b/src/TextShow/GHC/Fingerprint.hs --- a/src/TextShow/GHC/Fingerprint.hs +++ b/src/TextShow/GHC/Fingerprint.hs @@ -5,24 +5,20 @@ #endif {-| Module: TextShow.GHC.Fingerprint -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' function for 'Fingerprint' values. -This module only exports functions if using @base-4.4.0.0@ or later. +'TextShow' instance for 'Fingerprint'. +Only provided if using @base-4.4.0.0@ or later. /Since: 2/ -} -module TextShow.GHC.Fingerprint ( -#if !(MIN_VERSION_base(4,4,0)) - ) where -#else - showbFingerprint - ) where +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) @@ -34,18 +30,11 @@ import TextShow.Data.Integral (showbHex) import TextShow.Utils (lengthB) --- | Convert a 'Fingerprint' to a 'Builder'. --- This function is only available with @base-4.4.0.0@ or later. --- --- /Since: 2/ -showbFingerprint :: Fingerprint -> Builder -showbFingerprint (Fingerprint w1 w2) = hex16 w1 <> hex16 w2 - where - hex16 :: Word64 -> Builder - hex16 i = let hex = showbHex i - in mtimesDefault (max 0 $ 16 - lengthB hex) (singleton '0') <> hex - +-- | /Since: 2/ instance TextShow Fingerprint where - showb = showbFingerprint - {-# INLINE showb #-} + showb (Fingerprint w1 w2) = hex16 w1 <> hex16 w2 + where + hex16 :: Word64 -> Builder + hex16 i = let hex = showbHex i + in mtimesDefault (max 0 $ 16 - lengthB hex) (singleton '0') <> hex #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 @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MagicHash #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} @@ -10,47 +11,17 @@ {-| Module: TextShow.GHC.Generics -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' functions for generics-related data types. +'TextShow' instances for generics-related data types. /Since: 2/ -} -module TextShow.GHC.Generics ( - showbU1 - , liftShowbPar1Prec - , showbRec1Prec - , liftShowbRec1Prec - , liftShowbK1Prec - , showbM1Prec - , liftShowbM1Prec - , showbSumTypePrec - , liftShowbSumTypePrec - , showbProductTypePrec - , liftShowbProductTypePrec - , showbCompFunctorsPrec - , liftShowbCompFunctorsPrec - , showbFixityPrec - , showbAssociativity -#if MIN_VERSION_base(4,9,0) - , showbSourceUnpackedness - , showbSourceStrictness - , showbDecidedStrictness -#else - , showbArityPrec -#endif - , showbUCharPrec - , showbUDoublePrec - , showbUFloatPrec - , showbUIntPrec - , showbUWordPrec - ) where - -import Data.Text.Lazy.Builder (Builder) +module TextShow.GHC.Generics () where import Generics.Deriving.Base @@ -63,7 +34,7 @@ #if !(MIN_VERSION_template_haskell(2,7,0)) import Data.Monoid.Compat ((<>)) -import Data.Text.Lazy.Builder (fromString, singleton) +import Data.Text.Lazy.Builder (singleton) import GHC.Exts (Char(C#), Double(D#), Float(F#), Int(I#), Word(W#)) import GHC.Show (appPrec) @@ -71,291 +42,160 @@ import TextShow.Classes (showbParen) #endif --- | Convert a 'U1' value to a 'Builder'. --- --- /Since: 2/ -showbU1 :: U1 p -> Builder -showbU1 = showb -{-# INLINE showbU1 #-} - --- | Convert a 'Par1' value to a 'Builder' with the given show function and precedence. --- --- /Since: 3/ -liftShowbPar1Prec :: (Int -> p -> Builder) -> Int -> Par1 p -> Builder -liftShowbPar1Prec sp = liftShowbPrec sp undefined -{-# INLINE liftShowbPar1Prec #-} - --- | Convert a 'Rec1' value to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbRec1Prec :: TextShow (f p) => Int -> Rec1 f p -> Builder -showbRec1Prec = showbPrec -{-# INLINE showbRec1Prec #-} - --- | Convert a 'Rec1' value to a 'Builder' with the given show function and precedence. --- --- /Since: 3/ -liftShowbRec1Prec :: TextShow1 f => (Int -> p -> Builder) -> ([p] -> Builder) - -> Int -> Rec1 f p -> Builder -liftShowbRec1Prec = liftShowbPrec -{-# INLINE liftShowbRec1Prec #-} - --- | Convert a 'K1' value to a 'Builder' with the given show function and precedence. --- --- /Since: 3/ -liftShowbK1Prec :: (Int -> c -> Builder) -> Int -> K1 i c p -> Builder -liftShowbK1Prec sp = liftShowbPrec2 sp undefined undefined undefined -{-# INLINE liftShowbK1Prec #-} - --- | Convert an 'M1' value to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbM1Prec :: TextShow (f p) => Int -> M1 i c f p -> Builder -showbM1Prec = showbPrec -{-# INLINE showbM1Prec #-} - --- | Convert an 'M1' value to a 'Builder' with the given show function and precedence. --- --- /Since: 3/ -liftShowbM1Prec :: TextShow1 f => (Int -> p -> Builder) -> ([p] -> Builder) - -> Int -> M1 i c f p -> Builder -liftShowbM1Prec = liftShowbPrec -{-# INLINE liftShowbM1Prec #-} - --- | Convert a '(:+:)' value to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbSumTypePrec :: (TextShow (f p), TextShow (g p)) => Int -> (f :+: g) p -> Builder -showbSumTypePrec = showbPrec -{-# INLINE showbSumTypePrec #-} - --- | Convert a '(:+:)' value to a 'Builder' with the given show function and precedence. --- --- /Since: 3/ -liftShowbSumTypePrec :: (TextShow1 f, TextShow1 g) - => (Int -> p -> Builder) -> ([p] -> Builder) - -> Int -> (f :+: g) p -> Builder -liftShowbSumTypePrec = liftShowbPrec -{-# INLINE liftShowbSumTypePrec #-} - --- | Convert a '(:*:)' value to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbProductTypePrec :: (TextShow (f p), TextShow (g p)) => Int -> (f :*: g) p -> Builder -showbProductTypePrec = showbPrec -{-# INLINE showbProductTypePrec #-} - --- | Convert a '(:*:)' value to a 'Builder' with the given show function and precedence. --- --- /Since: 3/ -liftShowbProductTypePrec :: (TextShow1 f, TextShow1 g) - => (Int -> p -> Builder) -> ([p] -> Builder) - -> Int -> (f :*: g) p -> Builder -liftShowbProductTypePrec = liftShowbPrec -{-# INLINE liftShowbProductTypePrec #-} - --- | Convert a '(:.:)' value to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbCompFunctorsPrec :: TextShow (f (g p)) => Int -> (f :.: g) p -> Builder -showbCompFunctorsPrec = showbPrec -{-# INLINE showbCompFunctorsPrec #-} - --- | Convert a '(:.:)' value to a 'Builder' with the given show function and precedence. --- --- /Since: 3/ -liftShowbCompFunctorsPrec :: (TextShow1 f, TextShow1 g) - => (Int -> p -> Builder) -> ([p] -> Builder) - -> Int -> (f :.: g) p -> Builder -liftShowbCompFunctorsPrec = liftShowbPrec -{-# INLINE liftShowbCompFunctorsPrec #-} - --- | Convert a 'Fixity' value to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbFixityPrec :: Int -> Fixity -> Builder -showbFixityPrec = showbPrec -{-# INLINE showbFixityPrec #-} - --- | Convert an 'Associativity' value to a 'Builder'. --- --- /Since: 2/ -showbAssociativity :: Associativity -> Builder -showbAssociativity = showb -{-# INLINE showbAssociativity #-} - -#if MIN_VERSION_base(4,9,0) --- | Convert a 'SourceUnpackedness' value to a 'Builder'. --- This function is only available with @base-4.9.0.0@ or later. --- --- /Since: 3/ -showbSourceUnpackedness :: SourceUnpackedness -> Builder -showbSourceUnpackedness = showb -{-# INLINE showbSourceUnpackedness #-} - --- | Convert a 'SourceStrictness' value to a 'Builder'. --- This function is only available with @base-4.9.0.0@ or later. --- --- /Since: 3/ -showbSourceStrictness :: SourceStrictness -> Builder -showbSourceStrictness = showb -{-# INLINE showbSourceStrictness #-} - --- | Convert a 'DecidedStrictness' value to a 'Builder'. --- This function is only available with @base-4.9.0.0@ or later. --- --- /Since: 3/ -showbDecidedStrictness :: DecidedStrictness -> Builder -showbDecidedStrictness = showb -{-# INLINE showbDecidedStrictness #-} -#else --- | Convert an 'Arity' value to a 'Builder' with the given precedence. --- This function is only available with @base-4.8@ or earlier. --- --- /Since: 2/ -showbArityPrec :: Int -> Arity -> Builder -showbArityPrec = showbPrec -{-# INLINE showbArityPrec #-} -#endif - --- | Convert a 'UChar' to a 'Builder' with the given precedence. --- --- /Since: 2.1.2/ -showbUCharPrec :: Int -> UChar p -> Builder -showbUCharPrec = showbPrec -{-# INLINE showbUCharPrec #-} - --- | Convert a 'UDouble' to a 'Builder' with the given precedence. --- --- /Since: 2.1.2/ -showbUDoublePrec :: Int -> UDouble p -> Builder -showbUDoublePrec = showbPrec -{-# INLINE showbUDoublePrec #-} - --- | Convert a 'UFloat' to a 'Builder' with the given precedence. --- --- /Since: 2.1.2/ -showbUFloatPrec :: Int -> UFloat p -> Builder -showbUFloatPrec = showbPrec -{-# INLINE showbUFloatPrec #-} - --- | Convert a 'UInt' to a 'Builder' with the given precedence. --- --- /Since: 2.1.2/ -showbUIntPrec :: Int -> UInt p -> Builder -showbUIntPrec = showbPrec -{-# INLINE showbUIntPrec #-} - --- | Convert a 'UWord' to a 'Builder' with the given precedence. --- --- /Since: 2.1.2/ -showbUWordPrec :: Int -> UWord p -> Builder -showbUWordPrec = showbPrec -{-# INLINE showbUWordPrec #-} - +-- | /Since: 2/ instance TextShow (U1 p) where showbPrec = liftShowbPrec undefined undefined +-- | /Since: 2/ $(deriveTextShow1 ''U1) +-- | /Since: 2/ $(deriveTextShow ''Par1) +-- | /Since: 2/ $(deriveTextShow1 ''Par1) +-- | /Since: 2/ instance TextShow (f p) => TextShow (Rec1 f p) where showbPrec = $(makeShowbPrec ''Rec1) +-- | /Since: 2/ $(deriveTextShow1 ''Rec1) +-- | /Since: 2/ instance TextShow c => TextShow (K1 i c p) where showbPrec = liftShowbPrec undefined undefined +-- | /Since: 2/ instance TextShow c => TextShow1 (K1 i c) where liftShowbPrec = liftShowbPrec2 showbPrec showbList +-- | /Since: 2/ instance TextShow2 (K1 i) where liftShowbPrec2 = $(makeLiftShowbPrec2 ''K1) +-- | /Since: 2/ instance TextShow (f p) => TextShow (M1 i c f p) where showbPrec = $(makeShowbPrec ''M1) +-- | /Since: 2/ instance TextShow1 f => TextShow1 (M1 i c f) where liftShowbPrec = $(makeLiftShowbPrec ''M1) +-- | /Since: 2/ instance (TextShow (f p), TextShow (g p)) => TextShow ((f :+: g) p) where showbPrec = $(makeShowbPrec ''(:+:)) +-- | /Since: 2/ $(deriveTextShow1 ''(:+:)) +-- | /Since: 2/ instance (TextShow (f p), TextShow (g p)) => TextShow ((f :*: g) p) where showbPrec = $(makeShowbPrec ''(:*:)) +-- | /Since: 2/ $(deriveTextShow1 ''(:*:)) +-- | /Since: 2/ instance TextShow (f (g p)) => TextShow ((f :.: g) p) where showbPrec = $(makeShowbPrec ''(:.:)) +-- | /Since: 2/ $(deriveTextShow1 ''(:.:)) #if MIN_VERSION_template_haskell(2,7,0) +-- | /Since: 2.1.2/ instance TextShow (UChar p) where showbPrec = $(makeShowbPrec 'UChar) +-- | /Since: 2.1.2/ $(deriveTextShow1 'UChar) +-- | /Since: 2.1.2/ instance TextShow (UDouble p) where showbPrec = $(makeShowbPrec 'UDouble) +-- | /Since: 2.1.2/ $(deriveTextShow1 'UDouble) +-- | /Since: 2.1.2/ instance TextShow (UFloat p) where showbPrec = $(makeShowbPrec 'UFloat) +-- | /Since: 2.1.2/ $(deriveTextShow1 'UFloat) +-- | /Since: 2.1.2/ instance TextShow (UInt p) where showbPrec = $(makeShowbPrec 'UInt) +-- | /Since: 2.1.2/ $(deriveTextShow1 'UInt) +-- | /Since: 2.1.2/ instance TextShow (UWord p) where 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) $ - fromString "UChar " <> singleton '{' - <> fromString "uChar# = " <> showb (C# c) + "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) $ - fromString "UDouble " <> singleton '{' - <> fromString "uDouble# = " <> showb (D# d) + "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) $ - fromString "UFloat " <> singleton '{' - <> fromString "uFloat# = " <> showb (F# f) + "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) $ - fromString "UInt " <> singleton '{' - <> fromString "uInt# = " <> showb (I# i) + "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) $ - fromString "UWord " <> singleton '{' - <> fromString "uWord# = " <> showb (W# w) + "UWord " <> singleton '{' + <> "uWord# = " <> showb (W# w) <> singleton '}' #endif +-- | /Since: 2/ $(deriveTextShow ''Fixity) +-- | /Since: 2/ $(deriveTextShow ''Associativity) #if MIN_VERSION_base(4,9,0) +-- | Only available with @base-4.9.0.0@ or later. +-- +-- /Since: 3/ $(deriveTextShow ''SourceUnpackedness) +-- | Only available with @base-4.9.0.0@ or later. +-- +-- /Since: 3/ $(deriveTextShow ''SourceStrictness) +-- | Only available with @base-4.9.0.0@ or later. +-- +-- /Since: 3/ $(deriveTextShow ''DecidedStrictness) #else +-- | Only available with @base-4.8@ or earlier. +-- +-- /Since: 2/ $(deriveTextShow ''Arity) #endif diff --git a/src/TextShow/GHC/RTS/Flags.hs b/src/TextShow/GHC/RTS/Flags.hs --- a/src/TextShow/GHC/RTS/Flags.hs +++ b/src/TextShow/GHC/RTS/Flags.hs @@ -6,46 +6,22 @@ #endif {-| Module: TextShow.GHC.RTS.Flags -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' functions for data types in the 'GHC.RTS.Flags' module. -This module only exports functions if using @base-4.8.0.0@ or later. +'TextShow' instances for data types in the 'GHC.RTS.Flags' module. +Only provided if using @base-4.8.0.0@ or later. /Since: 2/ -} -module TextShow.GHC.RTS.Flags ( -#if !(MIN_VERSION_base(4,8,0)) - ) where -#else - showbRTSFlagsPrec - , showbGCFlagsPrec - , showbConcFlagsPrec - , showbMiscFlagsPrec - , showbDebugFlagsPrec - , showbCCFlagsPrec - , showbProfFlagsPrec - , showbTraceFlagsPrec - , showbTickyFlagsPrec -# if __GLASGOW_HASKELL__ >= 801 - , showbParFlagsPrec -# endif -# if MIN_VERSION_base(4,8,2) - , showbGiveGCStats - , showbDoCostCentres - , showbDoHeapProfile - , showbDoTrace -# endif - ) where - -import Data.Text.Lazy.Builder (Builder) +module TextShow.GHC.RTS.Flags () where +#if MIN_VERSION_base(4,8,0) import GHC.RTS.Flags -import TextShow.Classes (TextShow(..)) import TextShow.Data.Bool () import TextShow.Data.Char () import TextShow.Data.Floating () @@ -56,136 +32,37 @@ import TextShow.TH.Names (giveGCStatsTypeName, doCostCentresTypeName, doHeapProfileTypeName, doTraceTypeName) --- | Convert an 'RTSFlags' value to a 'Builder' with the given precedence. --- This function is only available with @base-4.8.0.0@ or later. --- --- /Since: 2/ -showbRTSFlagsPrec :: Int -> RTSFlags -> Builder -showbRTSFlagsPrec = showbPrec -{-# INLINE showbRTSFlagsPrec #-} - --- | Convert a 'GCFlags' value to a 'Builder' with the given precedence. --- This function is only available with @base-4.8.0.0@ or later. --- --- /Since: 2/ -showbGCFlagsPrec :: Int -> GCFlags -> Builder -showbGCFlagsPrec = showbPrec -{-# INLINE showbGCFlagsPrec #-} - --- | Convert a 'ConcFlags' value to a 'Builder' with the given precedence. --- This function is only available with @base-4.8.0.0@ or later. --- --- /Since: 2/ -showbConcFlagsPrec :: Int -> ConcFlags -> Builder -showbConcFlagsPrec = showbPrec -{-# INLINE showbConcFlagsPrec #-} - --- | Convert a 'MiscFlags' value to a 'Builder' with the given precedence. --- This function is only available with @base-4.8.0.0@ or later. --- --- /Since: 2/ -showbMiscFlagsPrec :: Int -> MiscFlags -> Builder -showbMiscFlagsPrec = showbPrec -{-# INLINE showbMiscFlagsPrec #-} - --- | Convert a 'DebugFlags' value to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbDebugFlagsPrec :: Int -> DebugFlags -> Builder -showbDebugFlagsPrec = showbPrec -{-# INLINE showbDebugFlagsPrec #-} - --- | Convert a 'CCFlags' value to a 'Builder' with the given precedence. --- This function is only available with @base-4.8.0.0@ or later. --- --- /Since: 2/ -showbCCFlagsPrec :: Int -> CCFlags -> Builder -showbCCFlagsPrec = showbPrec -{-# INLINE showbCCFlagsPrec #-} - --- | Convert a 'ProfFlags' value to a 'Builder' with the given precedence. --- This function is only available with @base-4.8.0.0@ or later. --- --- /Since: 2/ -showbProfFlagsPrec :: Int -> ProfFlags -> Builder -showbProfFlagsPrec = showbPrec -{-# INLINE showbProfFlagsPrec #-} - --- | Convert a 'TraceFlags' value to a 'Builder' with the given precedence. --- This function is only available with @base-4.8.0.0@ or later. --- --- /Since: 2/ -showbTraceFlagsPrec :: Int -> TraceFlags -> Builder -showbTraceFlagsPrec = showbPrec -{-# INLINE showbTraceFlagsPrec #-} - --- | Convert a 'TickyFlags' value to a 'Builder' with the given precedence. --- This function is only available with @base-4.8.0.0@ or later. --- --- /Since: 2/ -showbTickyFlagsPrec :: Int -> TickyFlags -> Builder -showbTickyFlagsPrec = showbPrec -{-# INLINE showbTickyFlagsPrec #-} - -# if __GLASGOW_HASKELL__ >= 801 --- | Convert a 'ParFlags' value to a 'Builder' with the given precedence. --- This function is only available with GHC 8.1 or later. --- --- /Since: 3.3/ -showbParFlagsPrec :: Int -> ParFlags -> Builder -showbParFlagsPrec = showbPrec -{-# INLINE showbParFlagsPrec #-} -# endif - -# if MIN_VERSION_base(4,8,2) --- | Convert a 'GiveGCStats' value to a 'Builder'. --- This function is only available with @base-4.8.2.0@ or later. --- --- /Since: 2.1/ -showbGiveGCStats :: GiveGCStats -> Builder -showbGiveGCStats = showb -{-# INLINE showbGiveGCStats #-} - --- | Convert a 'DoCostCentres' value to a 'Builder'. --- This function is only available with @base-4.8.2.0@ or later. --- --- /Since: 2.1/ -showbDoCostCentres :: DoCostCentres -> Builder -showbDoCostCentres = showb -{-# INLINE showbDoCostCentres #-} - --- | Convert a 'DoHeapProfile' value to a 'Builder'. --- This function is only available with @base-4.8.2.0@ or later. --- --- /Since: 2.1/ -showbDoHeapProfile :: DoHeapProfile -> Builder -showbDoHeapProfile = showb -{-# INLINE showbDoHeapProfile #-} - --- | Convert a 'DoTrace' value to a 'Builder'. --- This function is only available with @base-4.8.2.0@ or later. --- --- /Since: 2.1/ -showbDoTrace :: DoTrace -> Builder -showbDoTrace = showb -{-# INLINE showbDoTrace #-} -# endif - +-- | /Since: 2/ $(deriveTextShow ''RTSFlags) +-- | /Since: 2/ $(deriveTextShow ''GCFlags) +-- | /Since: 2/ $(deriveTextShow ''ConcFlags) +-- | /Since: 2/ $(deriveTextShow ''MiscFlags) +-- | /Since: 2/ $(deriveTextShow ''DebugFlags) +-- | /Since: 2/ $(deriveTextShow ''CCFlags) +-- | /Since: 2/ $(deriveTextShow ''ProfFlags) +-- | /Since: 2/ $(deriveTextShow ''TraceFlags) +-- | /Since: 2/ $(deriveTextShow ''TickyFlags) -# if __GLASGOW_HASKELL__ >= 801 +# if MIN_VERSION_base(4,10,0) +-- | Only available with @base-4.10.0.0@ or later. +-- +-- /Since: 3.3/ $(deriveTextShow ''ParFlags) # endif +-- | /Since: 2.1/ $(deriveTextShow giveGCStatsTypeName) +-- | /Since: 2.1/ $(deriveTextShow doCostCentresTypeName) +-- | /Since: 2.1/ $(deriveTextShow doHeapProfileTypeName) +-- | /Since: 2.1/ $(deriveTextShow doTraceTypeName) #endif diff --git a/src/TextShow/GHC/Stack.hs b/src/TextShow/GHC/Stack.hs --- a/src/TextShow/GHC/Stack.hs +++ b/src/TextShow/GHC/Stack.hs @@ -6,69 +6,44 @@ #endif {-| Module: TextShow.GHC.Stack -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' functions for 'CallStack' and 'SrcLoc' values. -This module only exports functions if using @base-4.8.1.0@ or later. +'TextShow' instances for 'CallStack' and 'SrcLoc' values. +Only provided if using @base-4.8.1.0@ or later. /Since: 3.0.1/ -} -module TextShow.GHC.Stack ( -#if !(MIN_VERSION_base(4,8,1)) - ) where -#else - showbCallStackPrec - , showbSrcLocPrec - ) where - -import Data.Text.Lazy.Builder (Builder) +module TextShow.GHC.Stack () where +#if MIN_VERSION_base(4,8,1) import GHC.Stack (CallStack) # if MIN_VERSION_base(4,9,0) import GHC.Stack (SrcLoc, getCallStack) +import TextShow.Classes (TextShow(..)) # else import GHC.SrcLoc (SrcLoc) # endif -import TextShow.Classes (TextShow(..)) import TextShow.Data.Char () import TextShow.Data.Integral () import TextShow.Data.List () import TextShow.Data.Tuple () import TextShow.TH.Internal (deriveTextShow) --- | Convert a 'CallStack' to a 'Builder' with the given precedence. --- This function is only available with @base-4.8.1.0@ or later. --- With @base-4.9@ or later, this function ignores the precedence argument. --- --- /Since: 3.0.1/ -showbCallStackPrec :: Int -> CallStack -> Builder # if MIN_VERSION_base(4,9,0) -showbCallStackPrec _ = showb . getCallStack -# else -showbCallStackPrec = showbPrec -# endif -{-# INLINE showbCallStackPrec #-} - --- | Convert a 'SrcLoc' to a 'Builder' with the given precedence. --- This function is only available with @base-4.8.1.0@ or later. --- --- /Since: 3.0.1/ -showbSrcLocPrec :: Int -> SrcLoc -> Builder -showbSrcLocPrec = showbPrec -{-# INLINE showbSrcLocPrec #-} - -# if MIN_VERSION_base(4,9,0) +-- | /Since: 3.0.1/ instance TextShow CallStack where - showb = showbCallStackPrec 0 + showb = showb . getCallStack {-# INLINE showb #-} # else +-- | /Since: 3.0.1/ $(deriveTextShow ''CallStack) # endif +-- | /Since: 3.0.1/ $(deriveTextShow ''SrcLoc) #endif diff --git a/src/TextShow/GHC/StaticPtr.hs b/src/TextShow/GHC/StaticPtr.hs --- a/src/TextShow/GHC/StaticPtr.hs +++ b/src/TextShow/GHC/StaticPtr.hs @@ -6,42 +6,28 @@ #endif {-| Module: TextShow.GHC.StaticPtr -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' function for 'StaticPtrInfo' values. -This module only exports functions if using @base-4.8.0.0@ or later. +'TextShow' instance for 'StaticPtrInfo'. +Only provided if using @base-4.8.0.0@ or later. /Since: 2/ -} -module TextShow.GHC.StaticPtr ( -#if !(MIN_VERSION_base(4,8,0)) - ) where -#else - showbStaticPtrInfoPrec - ) where - -import Data.Text.Lazy.Builder (Builder) +module TextShow.GHC.StaticPtr () where +#if MIN_VERSION_base(4,8,0) import GHC.StaticPtr (StaticPtrInfo) -import TextShow.Classes (showbPrec) import TextShow.Data.Char () import TextShow.Data.Integral () import TextShow.Data.List () import TextShow.Data.Tuple () import TextShow.TH.Internal (deriveTextShow) --- | Convert a 'StaticPtrInfo' value to a 'Builder' with the given precedence. --- This function is only available with @base-4.8.0.0@ or later. --- --- /Since: 2/ -showbStaticPtrInfoPrec :: Int -> StaticPtrInfo -> Builder -showbStaticPtrInfoPrec = showbPrec -{-# INLINE showbStaticPtrInfoPrec #-} - +-- | /Since: 2/ $(deriveTextShow ''StaticPtrInfo) #endif diff --git a/src/TextShow/GHC/Stats.hs b/src/TextShow/GHC/Stats.hs --- a/src/TextShow/GHC/Stats.hs +++ b/src/TextShow/GHC/Stats.hs @@ -2,44 +2,31 @@ #if MIN_VERSION_base(4,5,0) {-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -fno-warn-deprecations #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} #endif {-| Module: TextShow.GHC.Stats -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' function for 'GCStats'. -This module only exports functions if using @base-4.5.0.0@ or later. +'TextShow' instance for 'GCStats'. +Only provided if using @base-4.5.0.0@ or later. /Since: 2/ -} -module TextShow.GHC.Stats ( -#if !(MIN_VERSION_base(4,5,0)) - ) where -#else - showbGCStatsPrec - ) where - -import Data.Text.Lazy.Builder (Builder) +module TextShow.GHC.Stats () where +#if MIN_VERSION_base(4,5,0) import GHC.Stats (GCStats) -import TextShow.Classes (showbPrec) import TextShow.Data.Integral () import TextShow.Data.Floating () import TextShow.TH.Internal (deriveTextShow) --- | Convert a 'GCStats' value to a 'Builder' with the given precedence. --- This function is only available with @base-4.5.0.0@ or later. --- -- /Since: 2/ -showbGCStatsPrec :: Int -> GCStats -> Builder -showbGCStatsPrec = showbPrec -{-# INLINE showbGCStatsPrec #-} - $(deriveTextShow ''GCStats) #endif diff --git a/src/TextShow/GHC/TypeLits.hs b/src/TextShow/GHC/TypeLits.hs --- a/src/TextShow/GHC/TypeLits.hs +++ b/src/TextShow/GHC/TypeLits.hs @@ -14,110 +14,70 @@ #endif {-| Module: TextShow.GHC.TypeLits -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' functions for data types in the @GHC.TypeLits@ module. -This module only exports functions if using @base-4.6.0.0@ or later. +'TextShow' instances for data types in the @GHC.TypeLits@ module. +Only provided if using @base-4.6.0.0@ or later. /Since: 2/ -} -module TextShow.GHC.TypeLits ( -#if MIN_VERSION_base(4,7,0) - showbSomeNatPrec - , showbSomeSymbol - ) where -#elif MIN_VERSION_base(4,6,0) - showbIsEven - , showbIsZero - , showbSingPrec - ) where -#else - ) where -#endif +module TextShow.GHC.TypeLits () where #if MIN_VERSION_base(4,6,0) -import Data.Text.Lazy.Builder (Builder) import TextShow.Classes (TextShow(..)) +import TextShow.Data.Integral () # if MIN_VERSION_base(4,7,0) import GHC.TypeLits (SomeNat(..), SomeSymbol(..), natVal, symbolVal) -import TextShow.Data.Char (showbString) -import TextShow.Data.Integral (showbIntegerPrec) +import TextShow.Data.Char () # else import Data.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (singleton) import GHC.TypeLits (IsEven(..), IsZero(..), Kind, Sing, SingE(fromSing)) -import TextShow.Data.Integral () # endif # if MIN_VERSION_base(4,7,0) --- | Convert a 'SomeNat' value to a 'Builder' with the given precedence. --- This function is only available with @base-4.7.0.0@ or later. --- --- /Since: 2/ -showbSomeNatPrec :: Int -> SomeNat -> Builder -showbSomeNatPrec p (SomeNat x) = showbIntegerPrec p $ natVal x -{-# INLINE showbSomeNatPrec #-} - --- | Convert a 'SomeSymbol' value to a 'Builder' with the given precedence. --- This function is only available with @base-4.7.0.0@ or later. --- --- /Since: 2/ -showbSomeSymbol :: SomeSymbol -> Builder -showbSomeSymbol (SomeSymbol x) = showbString $ symbolVal x -{-# INLINE showbSomeSymbol #-} -# else --- | Convert an 'IsEven' value to a 'Builder'. --- This function is only available with @base-4.6@. --- --- /Since: 2/ -showbIsEven :: IsEven n -> Builder -showbIsEven IsEvenZero = singleton '0' -showbIsEven (IsEven x) = "(2 * " <> showb x <> singleton ')' -showbIsEven (IsOdd x) = "(2 * " <> showb x <> " + 1)" -{-# INLINE showbIsEven #-} - --- | Convert an 'IsZero' value to a 'Builder'. --- This function is only available with @base-4.6@. --- --- /Since: 2/ -showbIsZero :: IsZero n -> Builder -showbIsZero IsZero = singleton '0' -showbIsZero (IsSucc n) = singleton '(' <> showb n <> " + 1)" -{-# INLINE showbIsZero #-} - --- | Convert a 'Sing' value to a 'Builder' with the given precedence. +-- | Only available with @base-4.7.0.0@ or later. -- -- /Since: 2/ -showbSingPrec :: (SingE (Kind :: k) rep, TextShow rep) => Int -> Sing (a :: k) -> Builder -showbSingPrec p = showbPrec p . fromSing -{-# INLINE showbSingPrec #-} -# endif - -# if MIN_VERSION_base(4,7,0) instance TextShow SomeNat where - showbPrec = showbSomeNatPrec + showbPrec p (SomeNat x) = showbPrec p $ natVal x {-# INLINE showbPrec #-} +-- | Only available with @base-4.7.0.0@ or later. +-- +-- /Since: 2/ instance TextShow SomeSymbol where - showb = showbSomeSymbol + showb (SomeSymbol x) = showbList $ symbolVal x {-# INLINE showb #-} # else +-- | Only available with @base-4.6@. +-- +-- /Since: 2/ instance TextShow (IsEven n) where - showb = showbIsEven + showb IsEvenZero = singleton '0' + showb (IsEven x) = "(2 * " <> showb x <> singleton ')' + showb (IsOdd x) = "(2 * " <> showb x <> " + 1)" {-# INLINE showb #-} +-- | Only available with @base-4.6@. +-- +-- /Since: 2/ instance TextShow (IsZero n) where - showb = showbIsZero + showb IsZero = singleton '0' + showb (IsSucc n) = singleton '(' <> showb n <> " + 1)" {-# INLINE showb #-} +-- | Only available with @base-4.6@. +-- +-- /Since: 2/ instance (SingE (Kind :: k) rep, TextShow rep) => TextShow (Sing (a :: k)) where - showbPrec = showbSingPrec + showbPrec p = showbPrec p . fromSing {-# INLINE showbPrec #-} # endif diff --git a/src/TextShow/Generic.hs b/src/TextShow/Generic.hs --- a/src/TextShow/Generic.hs +++ b/src/TextShow/Generic.hs @@ -30,7 +30,7 @@ {-| Module: TextShow.Generic -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -119,8 +119,6 @@ import TextShow.Instances () import TextShow.TH.Internal (deriveTextShow) import TextShow.Utils (isInfixDataCon, isSymVar, isTupleString) - -#include "inline.h" {- $generics diff --git a/src/TextShow/Instances.hs b/src/TextShow/Instances.hs --- a/src/TextShow/Instances.hs +++ b/src/TextShow/Instances.hs @@ -1,6 +1,6 @@ {-| Module: TextShow.Instances -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional diff --git a/src/TextShow/Numeric/Natural.hs b/src/TextShow/Numeric/Natural.hs --- a/src/TextShow/Numeric/Natural.hs +++ b/src/TextShow/Numeric/Natural.hs @@ -5,47 +5,35 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Numeric.Natural -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' function for 'Natural's. +'TextShow' instance for 'Natural'. /Since: 2/ -} -module TextShow.Numeric.Natural (showbNaturalPrec) where - -import Data.Text.Lazy.Builder (Builder) +module TextShow.Numeric.Natural () where #if MIN_VERSION_base(4,8,0) import GHC.Integer.GMP.Internals (Integer(..)) import GHC.Natural (Natural(..)) import GHC.Types (Word(..)) - -import TextShow.Data.Integral (showbWord) #else import Numeric.Natural (Natural) #endif import TextShow.Classes (TextShow(..)) -import TextShow.Data.Integral (showbIntegerPrec) - -#include "inline.h" +import TextShow.Data.Integral () --- | Convert a 'Natural' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbNaturalPrec :: Int -> Natural -> Builder +-- | /Since: 2/ +instance TextShow Natural where #if MIN_VERSION_base(4,8,0) -showbNaturalPrec _ (NatS# w#) = showbWord $ W# w# -showbNaturalPrec p (NatJ# bn) = showbIntegerPrec p $ Jp# bn + showbPrec _ (NatS# w#) = showb $ W# w# + showbPrec p (NatJ# bn) = showbPrec p $ Jp# bn #else -showbNaturalPrec p = showbIntegerPrec p . toInteger -{-# INLINE showbNaturalPrec #-} + showbPrec p = showbPrec p . toInteger + {-# INLINE showbPrec #-} #endif - -instance TextShow Natural where - showbPrec = showbNaturalPrec - INLINE_INST_FUN(showbPrec) diff --git a/src/TextShow/Options.hs b/src/TextShow/Options.hs --- a/src/TextShow/Options.hs +++ b/src/TextShow/Options.hs @@ -22,7 +22,7 @@ {-| Module: TextShow.FromStringTextShow -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional diff --git a/src/TextShow/System/Exit.hs b/src/TextShow/System/Exit.hs --- a/src/TextShow/System/Exit.hs +++ b/src/TextShow/System/Exit.hs @@ -2,31 +2,22 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.System.Exit -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' function for 'ExitCode'. +'TextShow' instance for 'ExitCode'. /Since: 2/ -} -module TextShow.System.Exit (showbExitCodePrec) where - -import Data.Text.Lazy.Builder (Builder) +module TextShow.System.Exit () where import System.Exit (ExitCode) -import TextShow.Classes (showbPrec) import TextShow.Data.Integral () import TextShow.TH.Internal (deriveTextShow) --- | Convert an 'ExitCode' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbExitCodePrec :: Int -> ExitCode -> Builder -showbExitCodePrec = showbPrec -{-# INLINE showbExitCodePrec #-} - +-- | /Since: 2/ $(deriveTextShow ''ExitCode) 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 @@ -4,30 +4,17 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.System.IO -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' function for 'IO'-related data types. +'TextShow' instances for 'IO'-related data types. /Since: 2/ -} -module TextShow.System.IO ( - showbHandle - , showbIOMode - , showbBufferModePrec - , showbHandlePosn - , showbSeekMode - , showbTextEncoding -#if MIN_VERSION_base(4,4,0) - , showbCodingProgress - , showbCodingFailureMode -#endif - , showbNewline - , showbNewlineModePrec - ) where +module TextShow.System.IO () where import Data.Monoid.Compat ((<>)) import Data.Text.Lazy.Builder (Builder, fromString, singleton) @@ -43,114 +30,51 @@ import System.IO (BufferMode, IOMode, Newline, NewlineMode, SeekMode) import TextShow.Classes (TextShow(..)) -import TextShow.Data.Integral (showbIntegerPrec) +import TextShow.Data.Integral () import TextShow.Data.Maybe () import TextShow.TH.Internal (deriveTextShow) -#include "inline.h" - --- | Convert a 'Handle' to a 'Builder'. --- --- /Since: 2/ -showbHandle :: Handle -> Builder -showbHandle (FileHandle file _) = showbHandleFilePath file -showbHandle (DuplexHandle file _ _) = showbHandleFilePath file -{-# INLINE showbHandle #-} +-- | /Since: 2/ +instance TextShow Handle where + showb (FileHandle file _) = showbHandleFilePath file + showb (DuplexHandle file _ _) = showbHandleFilePath file + {-# INLINE showb #-} -- | Convert a 'Handle`'s 'FilePath' to a 'Builder'. showbHandleFilePath :: FilePath -> Builder showbHandleFilePath file = "{handle: " <> fromString file <> singleton '}' {-# INLINE showbHandleFilePath #-} --- | Convert an 'IOMode' to a 'Builder'. --- --- /Since: 2/ -showbIOMode :: IOMode -> Builder -showbIOMode = showb -{-# INLINE showbIOMode #-} - --- | Convert a 'BufferMode' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbBufferModePrec :: Int -> BufferMode -> Builder -showbBufferModePrec = showbPrec -{-# INLINE showbBufferModePrec #-} - --- | Convert a 'HandlePosn' to a 'Builder'. --- --- /Since: 2/ -showbHandlePosn :: HandlePosn -> Builder -showbHandlePosn (HandlePosn h pos) - = showbHandle h <> " at position " <> showbIntegerPrec 0 pos -{-# INLINE showbHandlePosn #-} - --- | Convert a 'SeekMode' to a 'Builder'. --- --- /Since: 2/ -showbSeekMode :: SeekMode -> Builder -showbSeekMode = showb -{-# INLINE showbSeekMode #-} - --- | Convert a 'TextEncoding' to a 'Builder'. --- --- /Since: 2/ -showbTextEncoding :: TextEncoding -> Builder -showbTextEncoding = fromString . textEncodingName -{-# INLINE showbTextEncoding #-} - -#if MIN_VERSION_base(4,4,0) --- | Convert a 'CodingProgress' to a 'Builder'. --- This function is only available with @base-4.4.0.0@ or later. --- --- /Since: 2/ -showbCodingProgress :: CodingProgress -> Builder -showbCodingProgress = showb -{-# INLINE showbCodingProgress #-} - --- | Convert a 'CodingFailureMode' value to a 'Builder'. --- This function is only available with @base-4.4.0.0@ or later. --- --- /Since: 2/ -showbCodingFailureMode :: CodingFailureMode -> Builder -showbCodingFailureMode = showb -{-# INLINE showbCodingFailureMode #-} -#endif - --- | Convert a 'Newline' to a 'Builder'. --- --- /Since: 2/ -showbNewline :: Newline -> Builder -showbNewline = showb -{-# INLINE showbNewline #-} - --- | Convert a 'NewlineMode' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbNewlineModePrec :: Int -> NewlineMode -> Builder -showbNewlineModePrec = showbPrec -{-# INLINE showbNewlineModePrec #-} - -instance TextShow Handle where - showb = showbHandle - INLINE_INST_FUN(showb) - +-- | /Since: 2/ $(deriveTextShow ''IOMode) +-- | /Since: 2/ $(deriveTextShow ''BufferMode) +-- | /Since: 2/ instance TextShow HandlePosn where - showb = showbHandlePosn - INLINE_INST_FUN(showb) + showb (HandlePosn h pos) = showb h <> " at position " <> showbPrec 0 pos + {-# INLINE showb #-} +-- | /Since: 2/ $(deriveTextShow ''SeekMode) +-- | /Since: 2/ instance TextShow TextEncoding where - showb = showbTextEncoding - INLINE_INST_FUN(showb) + showb = fromString . textEncodingName + {-# INLINE showb #-} #if MIN_VERSION_base(4,4,0) +-- | Only available with @base-4.4.0.0@ or later. +-- +-- /Since: 2/ $(deriveTextShow ''CodingProgress) +-- | Only available with @base-4.4.0.0@ or later. +-- +-- /Since: 2/ $(deriveTextShow ''CodingFailureMode) #endif +-- | /Since: 2/ $(deriveTextShow ''Newline) +-- | /Since: 2/ $(deriveTextShow ''NewlineMode) 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 @@ -5,388 +5,242 @@ {-| Module: TextShow.System.Posix.Types -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' functions for Haskell equivalents of POSIX data types. -Note that these functions are only available if the operating system supports them, -so some OSes (e.g., Windows) will not be able to use all of the functions in this +'TextShow' instances for Haskell equivalents of POSIX data types. +Note that these are only available if the operating system supports them, +so some OSes (e.g., Windows) will not be able to use all of the instances in this module. /Since: 2/ -} #include "HsBaseConfig.h" -module TextShow.System.Posix.Types ( - showbFdPrec -#if defined(HTYPE_DEV_T) - , showbCDev -#endif -#if defined(HTYPE_INO_T) - , showbCIno -#endif -#if defined(HTYPE_MODE_T) - , showbCMode -#endif -#if defined(HTYPE_OFF_T) - , showbCOffPrec -#endif -#if defined(HTYPE_PID_T) - , showbCPidPrec -#endif -#if defined(HTYPE_SSIZE_T) - , showbCSsizePrec -#endif -#if defined(HTYPE_GID_T) - , showbCGid -#endif -#if defined(HTYPE_NLINK_T) - , showbCNlink -#endif -#if defined(HTYPE_UID_T) - , showbCUid -#endif -#if defined(HTYPE_CC_T) - , showbCCc -#endif -#if defined(HTYPE_SPEED_T) - , showbCSpeed -#endif -#if defined(HTYPE_TCFLAG_T) - , showbCTcflag -#endif -#if defined(HTYPE_RLIM_T) - , showbCRLim -#endif - ) where - -import Data.Text.Lazy.Builder (Builder) +module TextShow.System.Posix.Types () where import System.Posix.Types import TextShow.Classes (TextShow(..)) -import TextShow.Data.Integral () +import TextShow.Data.Integral () 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" -# include "inline.h" #endif -#if defined(HTYPE_DEV_T) --- | Convert a 'CDev' to a 'Builder'. --- --- /Since: 2/ -showbCDev :: CDev -> Builder -# if MIN_VERSION_base(4,5,0) -showbCDev = showb -{-# INLINE showbCDev #-} -# else -showbCDev = unsafeCoerce (showb :: HTYPE_DEV_T -> Builder) -# endif -#endif - -#if defined(HTYPE_INO_T) --- | Convert a 'CIno' to a 'Builder'. --- --- /Since: 2/ -showbCIno :: CIno -> Builder -# if MIN_VERSION_base(4,5,0) -showbCIno = showb -{-# INLINE showbCIno #-} -# else -showbCIno = unsafeCoerce (showb :: HTYPE_INO_T -> Builder) -# endif -#endif - -#if defined(HTYPE_MODE_T) --- | Convert a 'CMode' to a 'Builder'. --- --- /Since: 2/ -showbCMode :: CMode -> Builder -# if MIN_VERSION_base(4,5,0) -showbCMode = showb -{-# INLINE showbCMode #-} -# else -showbCMode = unsafeCoerce (showb :: HTYPE_MODE_T -> Builder) -# endif -#endif - -#if defined(HTYPE_OFF_T) --- | Convert a 'COff' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbCOffPrec :: Int -> COff -> Builder -# if MIN_VERSION_base(4,5,0) -showbCOffPrec = showbPrec -{-# INLINE showbCOffPrec #-} -# else -showbCOffPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_OFF_T -> Builder) -# endif -#endif - -#if defined(HTYPE_PID_T) --- | Convert a 'CPid' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbCPidPrec :: Int -> CPid -> Builder -# if MIN_VERSION_base(4,5,0) -showbCPidPrec = showbPrec -{-# INLINE showbCPidPrec #-} -# else -showbCPidPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_PID_T -> Builder) -# endif -#endif - -#if defined(HTYPE_SSIZE_T) --- | Convert a 'CSsize' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbCSsizePrec :: Int -> CSsize -> Builder -# if MIN_VERSION_base(4,5,0) -showbCSsizePrec = showbPrec -{-# INLINE showbCSsizePrec #-} -# else -showbCSsizePrec = unsafeCoerce (showbPrec :: Int -> HTYPE_SSIZE_T -> Builder) -# endif -#endif - -#if defined(HTYPE_GID_T) --- | Convert a 'CGid' to a 'Builder'. --- --- /Since: 2/ -showbCGid :: CGid -> Builder -# if MIN_VERSION_base(4,5,0) -showbCGid = showb -{-# INLINE showbCGid #-} -# else -showbCGid = unsafeCoerce (showb :: HTYPE_GID_T -> Builder) -# endif -#endif - -#if defined(HTYPE_NLINK_T) --- | Convert a 'CNlink' to a 'Builder'. --- --- /Since: 2/ -showbCNlink :: CNlink -> Builder -# if MIN_VERSION_base(4,5,0) -showbCNlink = showb -{-# INLINE showbCNlink #-} -# else -showbCNlink = unsafeCoerce (showb :: HTYPE_NLINK_T -> Builder) -# endif -#endif - -#if defined(HTYPE_UID_T) --- | Convert a 'CUid' to a 'Builder'. --- --- /Since: 2/ -showbCUid :: CUid -> Builder -# if MIN_VERSION_base(4,5,0) -showbCUid = showb -{-# INLINE showbCUid #-} -# else -showbCUid = unsafeCoerce (showb :: HTYPE_UID_T -> Builder) -# endif -#endif - -#if defined(HTYPE_CC_T) --- | Convert a 'CCc' to a 'Builder'. --- --- /Since: 2/ -showbCCc :: CCc -> Builder -# if MIN_VERSION_base(4,5,0) -showbCCc = showb -{-# INLINE showbCCc #-} -# else -showbCCc = unsafeCoerce (showb :: HTYPE_CC_T -> Builder) -# endif -#endif - -#if defined(HTYPE_SPEED_T) --- | Convert a 'CSpeed' to a 'Builder'. --- --- /Since: 2/ -showbCSpeed :: CSpeed -> Builder -# if MIN_VERSION_base(4,5,0) -showbCSpeed = showb -{-# INLINE showbCSpeed #-} -# else -showbCSpeed = unsafeCoerce (showb :: HTYPE_SPEED_T -> Builder) -# endif -#endif - -#if defined(HTYPE_TCFLAG_T) --- | Convert a 'CTcflag' to a 'Builder'. --- --- /Since: 2/ -showbCTcflag :: CTcflag -> Builder -# if MIN_VERSION_base(4,5,0) -showbCTcflag = showb -{-# INLINE showbCTcflag #-} -# else -showbCTcflag = unsafeCoerce (showb :: HTYPE_TCFLAG_T -> Builder) -# endif -#endif - -#if defined(HTYPE_RLIM_T) --- | Convert a 'CRLim' to a 'Builder'. --- --- /Since: 2/ -showbCRLim :: CRLim -> Builder -# if MIN_VERSION_base(4,5,0) -showbCRLim = showb -{-# INLINE showbCRLim #-} -# else -showbCRLim = unsafeCoerce (showb :: HTYPE_RLIM_T -> Builder) -# endif -#endif - --- | Convert an 'Fd' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbFdPrec :: Int -> Fd -> Builder -showbFdPrec = showbPrec -{-# INLINE showbFdPrec #-} - #if MIN_VERSION_base(4,5,0) # if defined(HTYPE_DEV_T) +-- | /Since: 2/ deriving instance TextShow CDev # endif # if defined(HTYPE_INO_T) +-- | /Since: 2/ deriving instance TextShow CIno # endif # if defined(HTYPE_MODE_T) +-- | /Since: 2/ deriving instance TextShow CMode # endif # if defined(HTYPE_OFF_T) +-- | /Since: 2/ deriving instance TextShow COff # endif # if defined(HTYPE_PID_T) +-- | /Since: 2/ deriving instance TextShow CPid # endif # if defined(HTYPE_SSIZE_T) +-- | /Since: 2/ deriving instance TextShow CSsize # endif # if defined(HTYPE_GID_T) +-- | /Since: 2/ deriving instance TextShow CGid # endif # if defined(HTYPE_NLINK_T) +-- | /Since: 2/ deriving instance TextShow CNlink # endif # if defined(HTYPE_UID_T) +-- | /Since: 2/ deriving instance TextShow CUid # endif # if defined(HTYPE_CC_T) +-- | /Since: 2/ deriving instance TextShow CCc # endif # if defined(HTYPE_SPEED_T) +-- | /Since: 2/ deriving instance TextShow CSpeed # endif # if defined(HTYPE_TCFLAG_T) +-- | /Since: 2/ deriving instance TextShow CTcflag # endif # 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 = showbCDev - INLINE_INST_FUN(showb) + showb = unsafeCoerce (showb :: HTYPE_DEV_T -> Builder) # endif # if defined(HTYPE_INO_T) +-- | /Since: 2/ instance TextShow CIno where - showb = showbCIno - INLINE_INST_FUN(showb) + showb = unsafeCoerce (showb :: HTYPE_INO_T -> Builder) # endif # if defined(HTYPE_MODE_T) +-- | /Since: 2/ instance TextShow CMode where - showb = showbCMode - INLINE_INST_FUN(showb) + showb = unsafeCoerce (showb :: HTYPE_MODE_T -> Builder) # endif # if defined(HTYPE_OFF_T) +-- | /Since: 2/ instance TextShow COff where - showbPrec = showbCOffPrec - INLINE_INST_FUN(showbPrec) + showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_OFF_T -> Builder) # endif # if defined(HTYPE_PID_T) +-- | /Since: 2/ instance TextShow CPid where - showbPrec = showbCPidPrec - INLINE_INST_FUN(showbPrec) + showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_PID_T -> Builder) # endif # if defined(HTYPE_SSIZE_T) +-- | /Since: 2/ instance TextShow CSsize where - showbPrec = showbCSsizePrec - INLINE_INST_FUN(showbPrec) + showbPrec = unsafeCoerce (showbPrec :: Int -> HTYPE_SSIZE_T -> Builder) # endif # if defined(HTYPE_GID_T) +-- | /Since: 2/ instance TextShow CGid where - showb = showbCGid - INLINE_INST_FUN(showb) + showb = unsafeCoerce (showb :: HTYPE_GID_T -> Builder) # endif # if defined(HTYPE_NLINK_T) +-- | /Since: 2/ instance TextShow CNlink where - showb = showbCNlink - INLINE_INST_FUN(showb) + showb = unsafeCoerce (showb :: HTYPE_NLINK_T -> Builder) # endif # if defined(HTYPE_UID_T) +-- | /Since: 2/ instance TextShow CUid where - showb = showbCUid - INLINE_INST_FUN(showb) + showb = unsafeCoerce (showb :: HTYPE_UID_T -> Builder) # endif # if defined(HTYPE_CC_T) +-- | /Since: 2/ instance TextShow CCc where - showb = showbCCc - INLINE_INST_FUN(showb) + showb = unsafeCoerce (showb :: HTYPE_CC_T -> Builder) # endif # if defined(HTYPE_SPEED_T) +-- | /Since: 2/ instance TextShow CSpeed where - showb = showbCSpeed - INLINE_INST_FUN(showb) + showb = unsafeCoerce (showb :: HTYPE_SPEED_T -> Builder) # endif # if defined(HTYPE_TCFLAG_T) +-- | /Since: 2/ instance TextShow CTcflag where - showb = showbCTcflag - INLINE_INST_FUN(showb) + showb = unsafeCoerce (showb :: HTYPE_TCFLAG_T -> Builder) # endif # if defined(HTYPE_RLIM_T) +-- | /Since: 2/ instance TextShow CRLim where - showb = showbCRLim - INLINE_INST_FUN(showb) + showb = unsafeCoerce (showb :: HTYPE_RLIM_T -> Builder) # endif #endif +#if MIN_VERSION_base(4,10,0) +# if defined(HTYPE_BLKSIZE_T) +-- | Only available with @base-4.10.0.0@ or later. +-- +-- /Since: 3.6/ +deriving instance TextShow CBlkSize +# endif + +# if defined(HTYPE_BLKCNT_T) +-- | Only available with @base-4.10.0.0@ or later. +-- +-- /Since: 3.6/ +deriving instance TextShow CBlkCnt +# endif + +# if defined(HTYPE_CLOCKID_T) +-- | Only available with @base-4.10.0.0@ or later. +-- +-- /Since: 3.6/ +deriving instance TextShow CClockId +# endif + +# if defined(HTYPE_FSBLKCNT_T) +-- | Only available with @base-4.10.0.0@ or later. +-- +-- /Since: 3.6/ +deriving instance TextShow CFsBlkCnt +# endif + +# if defined(HTYPE_FSFILCNT_T) +-- | Only available with @base-4.10.0.0@ or later. +-- +-- /Since: 3.6/ +deriving instance TextShow CFsFilCnt +# endif + +# if defined(HTYPE_ID_T) +-- | Only available with @base-4.10.0.0@ or later. +-- +-- /Since: 3.6/ +deriving instance TextShow CId +# endif + +# if defined(HTYPE_KEY_T) +-- | Only available with @base-4.10.0.0@ or later. +-- +-- /Since: 3.6/ +deriving instance TextShow CKey +# endif + +# if defined(HTYPE_TIMER_T) +-- | Only available with @base-4.10.0.0@ or later. +-- +-- /Since: 3.6/ +deriving instance TextShow CTimer +# endif +#endif + +-- | /Since: 2/ deriving instance TextShow Fd diff --git a/src/TextShow/TH.hs b/src/TextShow/TH.hs --- a/src/TextShow/TH.hs +++ b/src/TextShow/TH.hs @@ -3,7 +3,7 @@ {-| Module: TextShow.TH -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional 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 @@ -4,7 +4,7 @@ {-# LANGUAGE TemplateHaskell #-} {-| Module: TextShow.TH.Internal -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -89,8 +89,10 @@ import Prelude.Compat import TextShow.Classes (TextShow(..), TextShow1(..), TextShow2(..), - showbListWith, showbParen, showbSpace, - showtParen, showtSpace, showtlParen, showtlSpace) + showbListWith, + showbParen, showbCommaSpace, showbSpace, + showtParen, showtCommaSpace, showtSpace, + showtlParen, showtlCommaSpace, showtlSpace) import TextShow.Options (Options(..), GenTextMethods(..), defaultOptions) import TextShow.Utils (isInfixDataCon, isSymVar, isTupleString) @@ -599,7 +601,7 @@ (showString argNameBase) "" in [ varE (fromStringName tsFun) `appE` stringE (infixRec ++ " = ") , makeTextShowForArg 0 tsClass tsFun conName tvMap argTy arg - , varE (fromStringName tsFun) `appE` stringE ", " + , varE (showCommaSpaceName tsFun) ] ) (zip3 ts argTys args) @@ -1378,6 +1380,11 @@ showParenName ShowbPrec = 'showbParen showParenName ShowtPrec = 'showtParen showParenName ShowtlPrec = 'showtlParen + +showCommaSpaceName :: TextShowFun -> Name +showCommaSpaceName ShowbPrec = 'showbCommaSpace +showCommaSpaceName ShowtPrec = 'showtCommaSpace +showCommaSpaceName ShowtlPrec = 'showtlCommaSpace showSpaceName :: TextShowFun -> Name showSpaceName ShowbPrec = 'showbSpace diff --git a/src/TextShow/TH/Names.hs b/src/TextShow/TH/Names.hs deleted file mode 100644 --- a/src/TextShow/TH/Names.hs +++ /dev/null @@ -1,121 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE TemplateHaskell #-} - -{-| -Module: TextShow.TH.Names -Copyright: (C) 2014-2016 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Provisional -Portability: GHC - -Template Haskell names to eliminate some boilerplate. --} -module TextShow.TH.Names ( -#if MIN_VERSION_base(4,4,0) - evtCloseValName, - eventIsValName, - fdKeyTypeName, - uniqueTypeName, - asInt64ValName, -#endif -#if MIN_VERSION_base(4,6,0) - numberTypeName, -#endif -#if MIN_VERSION_base(4,8,0) - giveGCStatsTypeName, - doCostCentresTypeName, - doHeapProfileTypeName, - doTraceTypeName, -#endif - ) where - -#if MIN_VERSION_base(4,4,0) -import Language.Haskell.TH.Syntax -#endif - -#if MIN_VERSION_base(4,7,0) -import Text.Read.Lex (Number) -#endif - -#if __GLASGOW_HASKELL__ >= 711 -import GHC.RTS.Flags (GiveGCStats, DoCostCentres, DoHeapProfile, DoTrace) -#endif - -------------------------------------------------------------------------------- - -#if MIN_VERSION_base(4,4,0) --- | Creates a 'Name' for a value from the "GHC.Event.Internal" module. -mkEventName_v :: String -> Name -mkEventName_v = mkNameG_v "base" "GHC.Event.Internal" - --- | The 'Name' of 'evtClose'. -evtCloseValName :: Name -evtCloseValName = mkEventName_v "evtClose" - --- | The 'Name' of 'eventIs'. -eventIsValName :: Name -eventIsValName = mkEventName_v "eventIs" - --- | The 'Name' of 'FdKey'. -fdKeyTypeName :: Name -fdKeyTypeName = mkNameG_tc "base" "GHC.Event.Manager" "FdKey" - --- | The 'Name' of 'Unique'. -uniqueTypeName :: Name -uniqueTypeName = mkNameG_tc "base" "GHC.Event.Unique" "Unique" - --- | The 'Name' of 'asInt64'. -asInt64ValName :: Name -asInt64ValName = mkNameG_v "base" "GHC.Event.Unique" "asInt64" -#endif - -#if MIN_VERSION_base(4,6,0) --- | The 'Name' of 'Number'. -numberTypeName :: Name -# if MIN_VERSION_base(4,7,0) -numberTypeName = ''Number -# else -numberTypeName = mkNameG_tc "base" "Text.Read.Lex" "Number" -# endif -#endif - -#if MIN_VERSION_base(4,8,0) --- | The 'Name' of 'GiveGCStats'. -giveGCStatsTypeName :: Name -# if __GLASGOW_HASKELL__ >= 711 -giveGCStatsTypeName = ''GiveGCStats -# else -giveGCStatsTypeName = mkFlagsName_tc "GiveGCStats" -# endif - --- | The 'Name' of 'DoCostCentres'. -doCostCentresTypeName :: Name -# if __GLASGOW_HASKELL__ >= 711 -doCostCentresTypeName = ''DoCostCentres -# else -doCostCentresTypeName = mkFlagsName_tc "DoCostCentres" -# endif - --- | The 'Name' of 'DoHeapProfile'. -doHeapProfileTypeName :: Name -# if __GLASGOW_HASKELL__ >= 711 -doHeapProfileTypeName = ''DoHeapProfile -# else -doHeapProfileTypeName = mkFlagsName_tc "DoHeapProfile" -# endif - --- | The 'Name' of 'DoTrace'. -doTraceTypeName :: Name -# if __GLASGOW_HASKELL__ >= 711 -doTraceTypeName = ''DoTrace -# else -doTraceTypeName = mkFlagsName_tc "DoTrace" -# endif - --- | Creates a 'Name' for a type from the "GHC.RTS.Flags" module. -# if __GLASGOW_HASKELL__ < 711 -mkFlagsName_tc :: String -> Name -mkFlagsName_tc = mkNameG_tc "base" "GHC.RTS.Flags" -# endif -#endif diff --git a/src/TextShow/Text/Read.hs b/src/TextShow/Text/Read.hs --- a/src/TextShow/Text/Read.hs +++ b/src/TextShow/Text/Read.hs @@ -3,32 +3,21 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: TextShow.Text.Read -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional Portability: GHC -Monomorphic 'TextShow' function for 'Lexeme' (and 'Number', if using a +'TextShow' instance for 'Lexeme' (and 'Number', if using a recent-enough version of @base@). /Since: 2/ -} -module TextShow.Text.Read ( - showbLexemePrec -#if MIN_VERSION_base(4,7,0) - , showbNumberPrec -#endif - ) where - -import Data.Text.Lazy.Builder (Builder) +module TextShow.Text.Read () where import Text.Read.Lex (Lexeme) -#if MIN_VERSION_base(4,7,0) -import Text.Read.Lex (Number) -#endif -import TextShow.Classes (showbPrec) import TextShow.Data.Char () import TextShow.Data.Integral () import TextShow.Data.List () @@ -39,26 +28,11 @@ import TextShow.TH.Names (numberTypeName) #endif -#include "inline.h" - --- | Convert a 'Lexeme' to a 'Builder' with the given precedence. --- --- /Since: 2/ -showbLexemePrec :: Int -> Lexeme -> Builder -showbLexemePrec = showbPrec -{-# INLINE showbLexemePrec #-} - -#if MIN_VERSION_base(4,7,0) --- | Convert a 'Number' to a 'Builder' with the given precedence. --- This function is only available with @base-4.7.0.0@ or later. --- --- /Since: 2/ -showbNumberPrec :: Int -> Number -> Builder -showbNumberPrec = showbPrec -{-# INLINE showbNumberPrec #-} -#endif - +-- | /Since: 2/ $(deriveTextShow ''Lexeme) #if MIN_VERSION_base(4,6,0) +-- | Only available with @base-4.6.0.0@ or later. +-- +-- /Since: 2/ $(deriveTextShow numberTypeName) #endif diff --git a/src/TextShow/Utils.hs b/src/TextShow/Utils.hs --- a/src/TextShow/Utils.hs +++ b/src/TextShow/Utils.hs @@ -3,7 +3,7 @@ {-| Module: TextShow.Utils -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional diff --git a/tests/Derived/DataFamilies.hs b/tests/Derived/DataFamilies.hs --- a/tests/Derived/DataFamilies.hs +++ b/tests/Derived/DataFamilies.hs @@ -23,7 +23,7 @@ {-| Module: Derived.DataFamilies -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -55,10 +55,12 @@ # endif #endif +import Instances.Utils.GenericArbitrary (genericArbitrary) + import Prelude () import Prelude.Compat -import Test.QuickCheck (Arbitrary(..), oneof) +import Test.QuickCheck (Arbitrary(..)) #if MIN_VERSION_template_haskell(2,7,0) import Text.Show.Deriving (deriveShow1) @@ -86,9 +88,7 @@ ) instance (Arbitrary b, Arbitrary c, Arbitrary d) => Arbitrary (NotAllShow Int b c d) where - arbitrary = oneof [ NASShow1 <$> arbitrary <*> arbitrary - , NASShow2 <$> arbitrary - ] + arbitrary = genericArbitrary #if MIN_VERSION_template_haskell(2,7,0) # if !defined(NEW_FUNCTOR_CLASSES) @@ -135,11 +135,11 @@ instance (Arbitrary b, Arbitrary c) => Arbitrary (KindDistinguished (a :: ()) b c) where - arbitrary = KindDistinguishedUnit <$> arbitrary <*> arbitrary + arbitrary = genericArbitrary instance (Arbitrary b, Arbitrary c) => Arbitrary (KindDistinguished (a :: Bool) b c) where - arbitrary = KindDistinguishedBool <$> arbitrary <*> arbitrary + arbitrary = genericArbitrary # if !defined(NEW_FUNCTOR_CLASSES) $(deriveShow1 'KindDistinguishedUnit) diff --git a/tests/Derived/DatatypeContexts.hs b/tests/Derived/DatatypeContexts.hs --- a/tests/Derived/DatatypeContexts.hs +++ b/tests/Derived/DatatypeContexts.hs @@ -7,7 +7,7 @@ {-| Module: Derived.DatatypeContexts -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional diff --git a/tests/Derived/ExistentialQuantification.hs b/tests/Derived/ExistentialQuantification.hs --- a/tests/Derived/ExistentialQuantification.hs +++ b/tests/Derived/ExistentialQuantification.hs @@ -7,7 +7,7 @@ {-| Module: Derived.ExistentialQuantification -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional diff --git a/tests/Derived/Infix.hs b/tests/Derived/Infix.hs --- a/tests/Derived/Infix.hs +++ b/tests/Derived/Infix.hs @@ -14,7 +14,7 @@ {-| Module: Derived.Infix -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -42,10 +42,12 @@ # endif #endif +import Instances.Utils.GenericArbitrary (genericArbitrary) + import Prelude () import Prelude.Compat -import Test.QuickCheck (Arbitrary(..), oneof) +import Test.QuickCheck (Arbitrary(..)) import Text.Show.Deriving (deriveShow1) #if defined(NEW_FUNCTOR_CLASSES) @@ -131,26 +133,18 @@ ------------------------------------------------------------------------------- instance (Arbitrary a, Arbitrary b) => Arbitrary (TyConPlain a b) where - arbitrary = oneof (map pure [(:!:), (:@:), TyConPlain]) <*> arbitrary <*> arbitrary + arbitrary = genericArbitrary instance (Arbitrary a, Arbitrary b) => Arbitrary (TyConGADT a b) where - arbitrary = oneof [ pure (:.) - , pure (:..) - , flip (flip . (:...)) <$> arbitrary - , pure (:....) - ] - <*> arbitrary <*> arbitrary + arbitrary = genericArbitrary +#if MIN_VERSION_template_haskell(2,7,0) instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamilyPlain a b) where - arbitrary = oneof (map pure [(:#:), (:$:), TyFamilyPlain]) <*> arbitrary <*> arbitrary + arbitrary = genericArbitrary instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamilyGADT a b) where - arbitrary = oneof [ pure (:*) - , pure (:**) - , flip (flip . (:***)) <$> arbitrary - , pure (:****) - ] - <*> arbitrary <*> arbitrary + arbitrary = genericArbitrary +#endif ------------------------------------------------------------------------------- diff --git a/tests/Derived/MagicHash.hs b/tests/Derived/MagicHash.hs --- a/tests/Derived/MagicHash.hs +++ b/tests/Derived/MagicHash.hs @@ -13,7 +13,7 @@ {-| Module: Derived.MagicHash -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -32,6 +32,8 @@ import GHC.Generics (Generic, Generic1) #endif +import Instances.Utils.GenericArbitrary (genericArbitrary) + import Prelude () import Prelude.Compat @@ -82,26 +84,12 @@ ------------------------------------------------------------------------------- instance (Arbitrary a, Arbitrary b) => Arbitrary (TyCon# a b) where - arbitrary = do - a <- arbitrary - b <- arbitrary - I# i# <- arbitrary - F# f# <- arbitrary - D# d# <- arbitrary - C# c# <- arbitrary - W# w# <- arbitrary - pure $ TyCon# a b i# f# d# c# w# + arbitrary = genericArbitrary +#if MIN_VERSION_template_haskell(2,7,0) instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamily# a b) where - arbitrary = do - a <- arbitrary - b <- arbitrary - I# i# <- arbitrary - F# f# <- arbitrary - D# d# <- arbitrary - C# c# <- arbitrary - W# w# <- arbitrary - pure $ TyFamily# a b i# f# d# c# w# + arbitrary = genericArbitrary +#endif ------------------------------------------------------------------------------- diff --git a/tests/Derived/PolyKinds.hs b/tests/Derived/PolyKinds.hs --- a/tests/Derived/PolyKinds.hs +++ b/tests/Derived/PolyKinds.hs @@ -21,7 +21,7 @@ {-| Module: Derived.PolyKinds -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional diff --git a/tests/Derived/RankNTypes.hs b/tests/Derived/RankNTypes.hs --- a/tests/Derived/RankNTypes.hs +++ b/tests/Derived/RankNTypes.hs @@ -10,7 +10,7 @@ {-| Module: Derived.RankNTypes -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -62,19 +62,13 @@ ------------------------------------------------------------------------------- --- There's so much rank-n voodoo going on that we can't have a more generalized --- Arbitrary instances. Oh well, this is close enough. -instance Arbitrary (TyCon Int Int) where - arbitrary = do - i1 <- arbitrary - i2 <- arbitrary - pure $ TyCon (Tagged2 i1) (Tagged2 i2) +instance (Arbitrary a, Arbitrary b) => Arbitrary (TyCon a b) where + arbitrary = (\i1 i2 -> TyCon (Tagged2 i1) (Tagged2 i2)) + <$> arbitrary <*> arbitrary -instance Arbitrary (TyFamily Int Int) where - arbitrary = do - i1 <- arbitrary - i2 <- arbitrary - pure $ TyFamily (Tagged2 i1) (Tagged2 i2) +instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamily a b) where + arbitrary = (\i1 i2 -> TyFamily (Tagged2 i1) (Tagged2 i2)) + <$> arbitrary <*> arbitrary ------------------------------------------------------------------------------- diff --git a/tests/Derived/Records.hs b/tests/Derived/Records.hs --- a/tests/Derived/Records.hs +++ b/tests/Derived/Records.hs @@ -12,7 +12,7 @@ {-| Module: Derived.Records -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -35,10 +35,12 @@ # endif #endif +import Instances.Utils.GenericArbitrary (genericArbitrary) + import Prelude () import Prelude.Compat -import Test.QuickCheck (Arbitrary(..), oneof) +import Test.QuickCheck (Arbitrary(..)) import Text.Show.Deriving (deriveShow1) #if defined(NEW_FUNCTOR_CLASSES) @@ -80,14 +82,12 @@ ------------------------------------------------------------------------------- instance (Arbitrary a, Arbitrary b) => Arbitrary (TyCon a b) where - arbitrary = oneof [ TyConPrefix <$> arbitrary <*> arbitrary - , (:@:) <$> arbitrary <*> arbitrary - ] + arbitrary = genericArbitrary +#if MIN_VERSION_template_haskell(2,7,0) instance (Arbitrary a, Arbitrary b) => Arbitrary (TyFamily a b) where - arbitrary = oneof [ TyFamilyPrefix <$> arbitrary <*> arbitrary - , (:!:) <$> arbitrary <*> arbitrary - ] + arbitrary = genericArbitrary +#endif ------------------------------------------------------------------------------- diff --git a/tests/Derived/TypeSynonyms.hs b/tests/Derived/TypeSynonyms.hs --- a/tests/Derived/TypeSynonyms.hs +++ b/tests/Derived/TypeSynonyms.hs @@ -15,7 +15,7 @@ {-| Module: Derived.TypeSynonyms -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional 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,9 +1,17 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE DeriveGeneric #-} +#endif + {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Control.Concurrent -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -13,12 +21,15 @@ -} module Instances.Control.Concurrent () where -import GHC.Conc (BlockReason(..), ThreadStatus(..)) - -import Prelude () -import Prelude.Compat +#if __GLASGOW_HASKELL__ >= 704 +import GHC.Generics (Generic) +#else +import qualified Generics.Deriving.TH as Generics (deriveAll0) +#endif -import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum, oneof) +import GHC.Conc (BlockReason(..), ThreadStatus(..)) +import Instances.Utils.GenericArbitrary (genericArbitrary) +import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) deriving instance Bounded BlockReason deriving instance Enum BlockReason @@ -26,8 +37,10 @@ arbitrary = arbitraryBoundedEnum instance Arbitrary ThreadStatus where - arbitrary = oneof [ pure ThreadRunning - , pure ThreadFinished - , ThreadBlocked <$> arbitrary - , pure ThreadDied - ] + 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,11 +1,18 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE DeriveGeneric #-} +#endif + {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Control.Exception -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -15,24 +22,30 @@ -} module Instances.Control.Exception () where -import Control.Exception +import Control.Exception hiding (IOException) -import GHC.IO.Exception (IOException(..), IOErrorType(..)) +#if __GLASGOW_HASKELL__ >= 704 +import GHC.Generics (Generic) +#else +import qualified Generics.Deriving.TH as Generics (deriveAll0) +#endif -import Instances.Foreign.C.Types () -import Instances.System.IO () +import GHC.IO.Exception (IOException(..), IOErrorType(..)) -import Prelude () -import Prelude.Compat +import Instances.Foreign.C.Types () +import Instances.System.IO () +import Instances.Utils.GenericArbitrary (genericArbitrary) -import Test.QuickCheck (Arbitrary(..), Gen, arbitraryBoundedEnum, oneof) +import Prelude () +import Prelude.Compat +import Test.QuickCheck (Arbitrary(..), Gen, arbitraryBoundedEnum) + instance Arbitrary SomeException where arbitrary = SomeException <$> (arbitrary :: Gen AssertionFailed) instance Arbitrary IOException where - arbitrary = IOError <$> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary + arbitrary = genericArbitrary deriving instance Bounded IOErrorType deriving instance Enum IOErrorType @@ -45,12 +58,10 @@ arbitrary = arbitraryBoundedEnum instance Arbitrary ArrayException where - arbitrary = oneof [ IndexOutOfBounds <$> arbitrary - , UndefinedElement <$> arbitrary - ] + arbitrary = genericArbitrary instance Arbitrary AssertionFailed where - arbitrary = AssertionFailed <$> arbitrary + arbitrary = genericArbitrary #if MIN_VERSION_base(4,7,0) instance Arbitrary SomeAsyncException where @@ -62,54 +73,89 @@ instance Arbitrary AsyncException where arbitrary = arbitraryBoundedEnum +deriving instance Bounded NonTermination +deriving instance Enum NonTermination instance Arbitrary NonTermination where - arbitrary = pure NonTermination + arbitrary = arbitraryBoundedEnum +deriving instance Bounded NestedAtomically +deriving instance Enum NestedAtomically instance Arbitrary NestedAtomically where - arbitrary = pure NestedAtomically + arbitrary = arbitraryBoundedEnum +deriving instance Bounded BlockedIndefinitelyOnMVar +deriving instance Enum BlockedIndefinitelyOnMVar instance Arbitrary BlockedIndefinitelyOnMVar where - arbitrary = pure BlockedIndefinitelyOnMVar + arbitrary = arbitraryBoundedEnum +deriving instance Bounded BlockedIndefinitelyOnSTM +deriving instance Enum BlockedIndefinitelyOnSTM instance Arbitrary BlockedIndefinitelyOnSTM where - arbitrary = pure BlockedIndefinitelyOnSTM + arbitrary = arbitraryBoundedEnum #if MIN_VERSION_base(4,8,0) +deriving instance Bounded AllocationLimitExceeded +deriving instance Enum AllocationLimitExceeded instance Arbitrary AllocationLimitExceeded where - arbitrary = pure AllocationLimitExceeded + arbitrary = arbitraryBoundedEnum #endif #if MIN_VERSION_base(4,9,0) -instance Arbitrary TypeError where - arbitrary = TypeError <$> arbitrary +deriving instance Arbitrary TypeError #endif +#if MIN_VERSION_base(4,10,0) +deriving instance Arbitrary CompactionFailed +#endif + +deriving instance Bounded Deadlock +deriving instance Enum Deadlock instance Arbitrary Deadlock where - arbitrary = pure Deadlock + arbitrary = arbitraryBoundedEnum instance Arbitrary NoMethodError where - arbitrary = NoMethodError <$> arbitrary + arbitrary = genericArbitrary instance Arbitrary PatternMatchFail where - arbitrary = PatternMatchFail <$> arbitrary + arbitrary = genericArbitrary instance Arbitrary RecConError where - arbitrary = RecConError <$> arbitrary + arbitrary = genericArbitrary instance Arbitrary RecSelError where - arbitrary = RecSelError <$> arbitrary + arbitrary = genericArbitrary instance Arbitrary RecUpdError where - arbitrary = RecUpdError <$> arbitrary + arbitrary = genericArbitrary instance Arbitrary ErrorCall where -#if MIN_VERSION_base(4,9,0) - arbitrary = ErrorCallWithLocation <$> arbitrary <*> arbitrary -#else - arbitrary = ErrorCall <$> arbitrary -#endif + arbitrary = genericArbitrary deriving instance Bounded MaskingState deriving instance Enum MaskingState instance Arbitrary MaskingState where arbitrary = arbitraryBoundedEnum + +#if __GLASGOW_HASKELL__ >= 704 +deriving instance Generic ArrayException +deriving instance Generic AssertionFailed +deriving instance Generic IOException +deriving instance Generic Deadlock +deriving instance Generic NoMethodError +deriving instance Generic PatternMatchFail +deriving instance Generic RecConError +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/Control/Monad/ST.hs b/tests/Instances/Control/Monad/ST.hs --- a/tests/Instances/Control/Monad/ST.hs +++ b/tests/Instances/Control/Monad/ST.hs @@ -2,7 +2,7 @@ {-| Module: Instances.Control.Monad.ST -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional diff --git a/tests/Instances/Data/ByteString.hs b/tests/Instances/Data/ByteString.hs --- a/tests/Instances/Data/ByteString.hs +++ b/tests/Instances/Data/ByteString.hs @@ -2,7 +2,7 @@ {-| Module: Instances.Data.ByteString -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional diff --git a/tests/Instances/Data/Char.hs b/tests/Instances/Data/Char.hs --- a/tests/Instances/Data/Char.hs +++ b/tests/Instances/Data/Char.hs @@ -2,7 +2,7 @@ {-| Module: Instances.Data.Char -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional 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,9 +1,17 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE DeriveGeneric #-} +#endif + {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Data -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -13,31 +21,30 @@ -} 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) -import Prelude () -import Prelude.Compat +#if __GLASGOW_HASKELL__ >= 704 +import GHC.Generics (Generic) +#else +import qualified Generics.Deriving.TH as Generics (deriveAll0) +#endif -import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum, oneof) +import Instances.Utils.GenericArbitrary (genericArbitrary) +import Prelude () +import Prelude.Compat + +import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) + instance Arbitrary Constr where arbitrary = mkConstr <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary instance Arbitrary ConstrRep where - arbitrary = oneof [ AlgConstr <$> arbitrary - , IntConstr <$> arbitrary - , FloatConstr <$> arbitrary - , CharConstr <$> arbitrary - ] + arbitrary = genericArbitrary instance Arbitrary DataRep where - arbitrary = oneof [ AlgRep <$> arbitrary - , pure IntRep - , pure FloatRep - , pure CharRep - , pure NoRep - ] + arbitrary = genericArbitrary instance Arbitrary DataType where arbitrary = mkDataType <$> arbitrary <*> arbitrary @@ -46,3 +53,11 @@ deriving instance Enum Fixity 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/Dynamic.hs b/tests/Instances/Data/Dynamic.hs --- a/tests/Instances/Data/Dynamic.hs +++ b/tests/Instances/Data/Dynamic.hs @@ -2,7 +2,7 @@ {-| Module: Instances.Data.Dynamic -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional diff --git a/tests/Instances/Data/Floating.hs b/tests/Instances/Data/Floating.hs --- a/tests/Instances/Data/Floating.hs +++ b/tests/Instances/Data/Floating.hs @@ -4,7 +4,7 @@ {-| Module: Instances.Data.Floating -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional diff --git a/tests/Instances/Data/Functor/Compose.hs b/tests/Instances/Data/Functor/Compose.hs --- a/tests/Instances/Data/Functor/Compose.hs +++ b/tests/Instances/Data/Functor/Compose.hs @@ -10,7 +10,7 @@ {-| Module: Instances.Data.Functor.Compose -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional diff --git a/tests/Instances/Data/Functor/Product.hs b/tests/Instances/Data/Functor/Product.hs --- a/tests/Instances/Data/Functor/Product.hs +++ b/tests/Instances/Data/Functor/Product.hs @@ -8,7 +8,7 @@ {-| Module: Instances.Data.Functor.Product -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional diff --git a/tests/Instances/Data/Functor/Sum.hs b/tests/Instances/Data/Functor/Sum.hs --- a/tests/Instances/Data/Functor/Sum.hs +++ b/tests/Instances/Data/Functor/Sum.hs @@ -8,7 +8,7 @@ {-| Module: Instances.Data.Functor.Sum -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional diff --git a/tests/Instances/Data/List/NonEmpty.hs b/tests/Instances/Data/List/NonEmpty.hs deleted file mode 100644 --- a/tests/Instances/Data/List/NonEmpty.hs +++ /dev/null @@ -1,20 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -{-| -Module: Instances.Data.List.NonEmpty -Copyright: (C) 2014-2016 Ryan Scott -License: BSD-style (see the file LICENSE) -Maintainer: Ryan Scott -Stability: Provisional -Portability: GHC - -'Arbitrary' instance for 'NonEmpty'. --} -module Instances.Data.List.NonEmpty () where - -import Data.List.NonEmpty (NonEmpty) -import Text.Show.Deriving (deriveShow1) - --- TODO: Replace this with a non-orphan instance -$(deriveShow1 ''NonEmpty) diff --git a/tests/Instances/Data/OldTypeable.hs b/tests/Instances/Data/OldTypeable.hs --- a/tests/Instances/Data/OldTypeable.hs +++ b/tests/Instances/Data/OldTypeable.hs @@ -1,13 +1,15 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,7,0) && !(MIN_VERSION_base(4,8,0)) +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} #endif {-| Module: Instances.Data.OldTypeable -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -20,8 +22,11 @@ #if MIN_VERSION_base(4,7,0) && !(MIN_VERSION_base(4,8,0)) import Data.OldTypeable.Internal (TyCon(..), TypeRep(..)) +import GHC.Generics (Generic) + import Instances.GHC.Fingerprint () import Instances.Utils ((<@>)) +import Instances.Utils.GenericArbitrary (genericArbitrary) import Prelude () import Prelude.Compat @@ -32,6 +37,7 @@ arbitrary = TypeRep <$> arbitrary <*> arbitrary <@> [] -- arbitrary = TypeRep <$> arbitrary <*> arbitrary <*> arbitrary +deriving instance Generic TyCon instance Arbitrary TyCon where - arbitrary = TyCon <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + arbitrary = genericArbitrary #endif diff --git a/tests/Instances/Data/Ord.hs b/tests/Instances/Data/Ord.hs --- a/tests/Instances/Data/Ord.hs +++ b/tests/Instances/Data/Ord.hs @@ -4,7 +4,7 @@ {-| Module: Instances.Data.Ord -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional diff --git a/tests/Instances/Data/Proxy.hs b/tests/Instances/Data/Proxy.hs --- a/tests/Instances/Data/Proxy.hs +++ b/tests/Instances/Data/Proxy.hs @@ -1,14 +1,17 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 706 -{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} #endif {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Proxy -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -19,11 +22,14 @@ module Instances.Data.Proxy () where import Data.Proxy (Proxy(..)) - -import Prelude () -import Prelude.Compat - -import Test.QuickCheck (Arbitrary(..)) +#if __GLASGOW_HASKELL__ < 702 +import qualified Generics.Deriving.TH as Generics (deriveAll0) +#endif +import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) instance Arbitrary (Proxy s) where - arbitrary = pure Proxy + 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,10 +1,13 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Semigroup -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -14,13 +17,13 @@ -} module Instances.Data.Semigroup () where -import Data.Semigroup (Min(..), Max(..), First(..), Last(..), - WrappedMonoid(..), Option(..), Arg(..)) - -import Prelude () -import Prelude.Compat - -import Test.QuickCheck (Arbitrary(..)) +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) @@ -30,4 +33,8 @@ deriving instance Arbitrary a => Arbitrary (Option a) instance (Arbitrary a, Arbitrary b) => Arbitrary (Arg a b) where - arbitrary = Arg <$> arbitrary <*> arbitrary + 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,10 +1,18 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE DeriveGeneric #-} +#endif + +{-# OPTIONS_GHC -fno-warn-deprecations #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + {-| Module: Instances.Data.Text -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -14,26 +22,34 @@ -} 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 -import Prelude () -import Prelude.Compat +#if __GLASGOW_HASKELL__ >= 704 +import GHC.Generics (Generic) +#else +import qualified Generics.Deriving.TH as Generics (deriveAll0) +#endif -import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) -import Test.QuickCheck.Instances () +import Instances.Utils.GenericArbitrary (genericArbitrary) +import Prelude () +import Prelude.Compat + +import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) +import Test.QuickCheck.Instances () + instance Arbitrary Builder where arbitrary = fromString <$> arbitrary @@ -41,7 +57,7 @@ arbitrary = arbitraryBoundedEnum instance Arbitrary UnicodeException where - arbitrary = DecodeError <$> arbitrary <*> arbitrary + arbitrary = genericArbitrary #if MIN_VERSION_text(1,0,0) instance Arbitrary Decoding where @@ -51,4 +67,10 @@ #if MIN_VERSION_text(1,1,0) instance Arbitrary Size where 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,9 +1,17 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE DeriveGeneric #-} +#endif + {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Tuple -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -13,10 +21,14 @@ -} module Instances.Data.Tuple () where -import Prelude () -import Prelude.Compat - -import Test.QuickCheck (Arbitrary(..)) +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(..)) instance ( Arbitrary a , Arbitrary b @@ -30,10 +42,7 @@ , Arbitrary j , Arbitrary k ) => Arbitrary (a, b, c, d, e, f, g, h, i, j, k) where - arbitrary = (,,,,,,,,,,) - <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary + arbitrary = genericArbitrary instance ( Arbitrary a , Arbitrary b @@ -48,10 +57,7 @@ , Arbitrary k , Arbitrary l ) => Arbitrary (a, b, c, d, e, f, g, h, i, j, k, l) where - arbitrary = (,,,,,,,,,,,) - <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary + arbitrary = genericArbitrary instance ( Arbitrary a , Arbitrary b @@ -67,10 +73,7 @@ , Arbitrary l , Arbitrary m ) => Arbitrary (a, b, c, d, e, f, g, h, i, j, k, l, m) where - arbitrary = (,,,,,,,,,,,,) - <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary + arbitrary = genericArbitrary instance ( Arbitrary a , Arbitrary b @@ -87,10 +90,7 @@ , Arbitrary m , Arbitrary n ) => Arbitrary (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where - arbitrary = (,,,,,,,,,,,,,) - <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + arbitrary = genericArbitrary instance ( Arbitrary a , Arbitrary b @@ -108,7 +108,18 @@ , Arbitrary n , Arbitrary o ) => Arbitrary (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where - arbitrary = (,,,,,,,,,,,,,,) - <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + 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/Type/Coercion.hs b/tests/Instances/Data/Type/Coercion.hs --- a/tests/Instances/Data/Type/Coercion.hs +++ b/tests/Instances/Data/Type/Coercion.hs @@ -8,7 +8,7 @@ {-| Module: Instances.Data.Type.Coercion -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -22,11 +22,8 @@ import Data.Coerce (Coercible) import Data.Type.Coercion (Coercion(..)) -import Prelude () -import Prelude.Compat - -import Test.QuickCheck (Arbitrary(..)) +import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) instance Coercible a b => Arbitrary (Coercion a b) where - arbitrary = pure Coercion + arbitrary = arbitraryBoundedEnum #endif diff --git a/tests/Instances/Data/Type/Equality.hs b/tests/Instances/Data/Type/Equality.hs --- a/tests/Instances/Data/Type/Equality.hs +++ b/tests/Instances/Data/Type/Equality.hs @@ -10,7 +10,7 @@ {-| Module: Instances.Data.Type.Equality -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -21,13 +21,18 @@ module Instances.Data.Type.Equality () where #if MIN_VERSION_base(4,7,0) -import Data.Type.Equality ((:~:)(..)) - -import Prelude () -import Prelude.Compat +import Data.Type.Equality ((:~:)) +# if MIN_VERSION_base(4,10,0) +import Data.Type.Equality ((:~~:), type (~~)) +# endif -import Test.QuickCheck (Arbitrary(..)) +import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) instance a ~ b => Arbitrary (a :~: b) where - arbitrary = pure Refl + arbitrary = arbitraryBoundedEnum + +# if MIN_VERSION_base(4,10,0) +instance a ~~ b => Arbitrary (a :~~: b) where + arbitrary = arbitraryBoundedEnum +# endif #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 @@ -1,10 +1,17 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE MagicHash #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} + +#if __GLASGOW_HASKELL__ >= 706 +{-# LANGUAGE PolyKinds #-} +#endif + {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Data.Typeable -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -17,11 +24,7 @@ #include "MachDeps.h" #if MIN_VERSION_base(4,4,0) -import Data.Typeable.Internal (TypeRep(..)) import Instances.Utils ((<@>)) -#else -import Data.Typeable (TyCon, TypeRep, mkTyCon, typeOf) -import Test.QuickCheck (Gen) #endif #if MIN_VERSION_base(4,9,0) @@ -36,24 +39,82 @@ import Data.Typeable.Internal (TyCon(..)) #endif +#if MIN_VERSION_base(4,10,0) +import GHC.Exts (Int(..), Ptr(..)) +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) +#endif + +import Instances.Foreign.Ptr () import Instances.GHC.Fingerprint () import Prelude () import Prelude.Compat -import Test.QuickCheck (Arbitrary(..)) +import Test.QuickCheck +#if MIN_VERSION_base(4,10,0) +instance Typeable a => Arbitrary (TypeRep (a :: k)) where + arbitrary = pure (typeRep :: TypeRep (a :: k)) + +instance Arbitrary SomeTypeRep where + arbitrary = SomeTypeRep <$> (arbitrary :: Gen (TypeRep Int)) + +deriving instance Bounded TypeLitSort +deriving instance Enum TypeLitSort +instance Arbitrary TypeLitSort where + arbitrary = arbitraryBoundedEnum + +instance Arbitrary KindRep where + arbitrary = oneof [ KindRepTyConApp <$> arbitrary <@> [] + , KindRepVar <$> arbitrary + , KindRepApp <$> krt <*> krt + , krt + , do Ptr a# <- arbitrary + (\a -> KindRepTypeLitS a a#) <$> arbitrary + , KindRepTypeLitD <$> arbitrary <*> arbitrary + ] + where + krt = KindRepTYPE <$> arbitrary + +instance Arbitrary RuntimeRep where + arbitrary = oneof [ VecRep <$> arbitrary <*> arbitrary + , pure $ TupleRep [] + , pure $ SumRep [] + , pure LiftedRep + , pure UnliftedRep + , pure IntRep + , pure WordRep + , pure Int64Rep + , pure Word64Rep + , pure AddrRep + , pure FloatRep + , pure DoubleRep + ] + +instance Arbitrary VecCount where + arbitrary = arbitraryBoundedEnum + +instance Arbitrary VecElem where + arbitrary = arbitraryBoundedEnum +#else /* !(MIN_VERSION_base(4,10,0) */ instance Arbitrary TypeRep where -#if MIN_VERSION_base(4,4,0) +# 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 +# else <@> [] -# endif -#else +# endif +# else arbitrary = typeOf <$> (arbitrary :: Gen Int) +# endif #endif instance Arbitrary TyCon where @@ -66,7 +127,13 @@ W# w1# <- arbitrary W# w2# <- arbitrary # endif +# if MIN_VERSION_base(4,10,0) + I# i# <- arbitrary + (\a1 a2 a3 -> TyCon w1# w2# a1 a2 i# a3) + <$> arbitrary <*> arbitrary <*> arbitrary +# else TyCon w1# w2# <$> arbitrary <*> arbitrary +# endif #elif MIN_VERSION_base(4,4,0) arbitrary = TyCon <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary #else 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 @@ -9,7 +9,7 @@ {-| Module: Instances.Foreign.C.Types -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -54,14 +54,16 @@ deriving instance Arbitrary CSigAtomic deriving instance Arbitrary CClock deriving instance Arbitrary CTime -# if MIN_VERSION_base(4,4,0) deriving instance Arbitrary CUSeconds deriving instance Arbitrary CSUSeconds -# endif deriving instance Arbitrary CIntPtr deriving instance Arbitrary CUIntPtr deriving instance Arbitrary CIntMax deriving instance Arbitrary CUIntMax + +# if MIN_VERSION_base(4,10,0) +deriving instance Arbitrary CBool +# endif #else instance Arbitrary CChar where arbitrary = arbitrarySizedBoundedIntegral diff --git a/tests/Instances/Foreign/Ptr.hs b/tests/Instances/Foreign/Ptr.hs --- a/tests/Instances/Foreign/Ptr.hs +++ b/tests/Instances/Foreign/Ptr.hs @@ -2,7 +2,7 @@ {-| Module: Instances.Foreign.Ptr -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional diff --git a/tests/Instances/FromStringTextShow.hs b/tests/Instances/FromStringTextShow.hs --- a/tests/Instances/FromStringTextShow.hs +++ b/tests/Instances/FromStringTextShow.hs @@ -5,7 +5,7 @@ {-| Module: Instances.FromStringTextShow -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional diff --git a/tests/Instances/GHC/Conc/Windows.hs b/tests/Instances/GHC/Conc/Windows.hs --- a/tests/Instances/GHC/Conc/Windows.hs +++ b/tests/Instances/GHC/Conc/Windows.hs @@ -4,7 +4,7 @@ {-| Module: Instances.GHC.Conc.Windows -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional 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 @@ -4,7 +4,7 @@ {-| Module: Instances.GHC.Event -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional 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,9 +1,16 @@ -{-# LANGUAGE CPP #-} +{-# 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 -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -14,13 +21,23 @@ module Instances.GHC.Fingerprint () where #if MIN_VERSION_base(4,4,0) -import GHC.Fingerprint.Type (Fingerprint(..)) +import GHC.Fingerprint.Type (Fingerprint(..)) +# if __GLASGOW_HASKELL__ >= 704 +import GHC.Generics (Generic) +# else +import qualified Generics.Deriving.TH as Generics (deriveAll0) +# endif -import Prelude () -import Prelude.Compat +import Instances.Utils.GenericArbitrary (genericArbitrary) -import Test.QuickCheck (Arbitrary(..)) +import Test.QuickCheck (Arbitrary(..)) instance Arbitrary Fingerprint where - arbitrary = Fingerprint <$> arbitrary <*> arbitrary + arbitrary = genericArbitrary + +# if __GLASGOW_HASKELL__ >= 704 +deriving instance Generic Fingerprint +# else +$(Generics.deriveAll0 ''Fingerprint) +# endif #endif diff --git a/tests/Instances/GHC/Generics.hs b/tests/Instances/GHC/Generics.hs --- a/tests/Instances/GHC/Generics.hs +++ b/tests/Instances/GHC/Generics.hs @@ -2,7 +2,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MagicHash #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} @@ -10,7 +9,7 @@ {-| Module: Instances.GHC.Generics -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -21,18 +20,12 @@ module Instances.GHC.Generics () where import Data.Orphans () - import Generics.Deriving.Base - -import GHC.Exts (Char(C#), Double(D#), Float(F#), Int(I#), Word(W#)) - -import Prelude () -import Prelude.Compat - -import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum, oneof) +import Instances.Utils.GenericArbitrary (genericArbitrary) +import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) instance Arbitrary (U1 p) where - arbitrary = pure U1 + arbitrary = genericArbitrary deriving instance Arbitrary p => Arbitrary (Par1 p) deriving instance Arbitrary (f p) => Arbitrary (Rec1 f p) @@ -41,13 +34,13 @@ deriving instance Arbitrary (f (g p)) => Arbitrary ((f :.: g) p) instance (Arbitrary (f p), Arbitrary (g p)) => Arbitrary ((f :+: g) p) where - arbitrary = oneof [L1 <$> arbitrary, R1 <$> arbitrary] + arbitrary = genericArbitrary instance (Arbitrary (f p), Arbitrary (g p)) => Arbitrary ((f :*: g) p) where - arbitrary = (:*:) <$> arbitrary <*> arbitrary + arbitrary = genericArbitrary instance Arbitrary Fixity where - arbitrary = oneof [pure Prefix, Infix <$> arbitrary <*> arbitrary] + arbitrary = genericArbitrary instance Arbitrary Associativity where arbitrary = arbitraryBoundedEnum @@ -63,30 +56,20 @@ arbitrary = arbitraryBoundedEnum #else instance Arbitrary Arity where - arbitrary = oneof [pure NoArity, Arity <$> arbitrary] + arbitrary = genericArbitrary #endif instance Arbitrary (UChar p) where - arbitrary = do - C# c <- arbitrary - pure $ UChar c + arbitrary = genericArbitrary instance Arbitrary (UDouble p) where - arbitrary = do - D# d <- arbitrary - pure $ UDouble d + arbitrary = genericArbitrary instance Arbitrary (UFloat p) where - arbitrary = do - F# f <- arbitrary - pure $ UFloat f + arbitrary = genericArbitrary instance Arbitrary (UInt p) where - arbitrary = do - I# i <- arbitrary - pure $ UInt i + arbitrary = genericArbitrary instance Arbitrary (UWord p) where - arbitrary = do - W# w <- arbitrary - pure $ UWord w + arbitrary = genericArbitrary diff --git a/tests/Instances/GHC/RTS/Flags.hs b/tests/Instances/GHC/RTS/Flags.hs --- a/tests/Instances/GHC/RTS/Flags.hs +++ b/tests/Instances/GHC/RTS/Flags.hs @@ -1,9 +1,17 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} + +#if MIN_VERSION_base(4,8,0) +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +#endif {-| Module: Instances.GHC.RTS.Flags -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -11,34 +19,89 @@ 'Arbitrary' instances for data types in the "GHC.RTS.Flags" module. -} -module Instances.GHC.RTS.Flags () where +module Instances.GHC.RTS.Flags ( +#if !(MIN_VERSION_base(4,8,0)) + ) where +#else + GiveGCStats' + , DoCostCentres' + , DoHeapProfile' + , DoTrace' + ) where -#if MIN_VERSION_base(4,8,0) -import GHC.RTS.Flags -import Test.QuickCheck (Arbitrary(..)) -#endif +import qualified Generics.Deriving.TH as Generics (deriveAll0) +import GHC.RTS.Flags +import Instances.Utils.GenericArbitrary (genericArbitrary) +import Language.Haskell.TH.Lib (conT) +import Test.QuickCheck (Arbitrary(..)) +import TextShow.TH.Names -#if MIN_VERSION_base(4,8,0) +instance Arbitrary RTSFlags where + arbitrary = genericArbitrary + +instance Arbitrary GCFlags where + arbitrary = genericArbitrary + instance Arbitrary ConcFlags where - arbitrary = ConcFlags <$> arbitrary <*> arbitrary + arbitrary = genericArbitrary instance Arbitrary MiscFlags where - arbitrary = MiscFlags <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + arbitrary = genericArbitrary instance Arbitrary DebugFlags where - arbitrary = DebugFlags <$> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary + arbitrary = genericArbitrary +instance Arbitrary CCFlags where + arbitrary = genericArbitrary + +instance Arbitrary ProfFlags where + arbitrary = genericArbitrary + +instance Arbitrary TraceFlags where + arbitrary = genericArbitrary + instance Arbitrary TickyFlags where - arbitrary = TickyFlags <$> arbitrary <*> arbitrary -#endif + arbitrary = genericArbitrary -#if __GLASGOW_HASKELL__ >= 801 +# if MIN_VERSION_base(4,10,0) instance Arbitrary ParFlags where - arbitrary = ParFlags <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary + arbitrary = genericArbitrary +# endif + +type GiveGCStats' = $(conT giveGCStatsTypeName) +type DoCostCentres' = $(conT doCostCentresTypeName) +type DoHeapProfile' = $(conT doHeapProfileTypeName) +type DoTrace' = $(conT doTraceTypeName) + +-- TODO: Perhaps we should add deriving (Enum, Bounded) to deriving-compat +-- and use that instead of Generic? +instance Arbitrary GiveGCStats' where + arbitrary = genericArbitrary + +instance Arbitrary DoCostCentres' where + arbitrary = genericArbitrary + +instance Arbitrary DoHeapProfile' where + arbitrary = genericArbitrary + +instance Arbitrary DoTrace' where + arbitrary = genericArbitrary + +$(Generics.deriveAll0 ''RTSFlags) +$(Generics.deriveAll0 ''GCFlags) +$(Generics.deriveAll0 ''ConcFlags) +$(Generics.deriveAll0 ''MiscFlags) +$(Generics.deriveAll0 ''DebugFlags) +$(Generics.deriveAll0 ''CCFlags) +$(Generics.deriveAll0 ''ProfFlags) +$(Generics.deriveAll0 ''TraceFlags) +$(Generics.deriveAll0 ''TickyFlags) +# if MIN_VERSION_base(4,10,0) +$(Generics.deriveAll0 ''ParFlags) +# endif + +$(Generics.deriveAll0 giveGCStatsTypeName) +$(Generics.deriveAll0 doCostCentresTypeName) +$(Generics.deriveAll0 doHeapProfileTypeName) +$(Generics.deriveAll0 doTraceTypeName) #endif diff --git a/tests/Instances/GHC/Stack.hs b/tests/Instances/GHC/Stack.hs --- a/tests/Instances/GHC/Stack.hs +++ b/tests/Instances/GHC/Stack.hs @@ -1,9 +1,15 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} + +#if MIN_VERSION_base(4,8,1) +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +#endif {-| Module: Instances.GHC.Stack -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -13,24 +19,36 @@ -} module Instances.GHC.Stack () where --- Ideally, we'd also define these instances for base-4.8.1 and up, but the --- constructors for CallStack and SrcLoc aren't exposed prior to base-4.9, and --- the API doesn't provide any way to construct values of those types, so we're --- pretty much out of luck. -#if MIN_VERSION_base(4,9,0) -import GHC.Stack.Types (CallStack(..), SrcLoc(..)) +#if MIN_VERSION_base(4,8,1) +import qualified Generics.Deriving.TH as Generics (deriveAll0) +# if MIN_VERSION_base(4,9,0) +import GHC.Stack.Types (CallStack(..), SrcLoc(..)) +import Instances.Utils ((<@>)) +import Test.QuickCheck (oneof) +# else +import GHC.SrcLoc (SrcLoc) +import GHC.Stack (CallStack) +# endif -import Instances.Utils ((<@>)) +import Instances.Utils.GenericArbitrary (genericArbitrary) -import Test.QuickCheck (Arbitrary(..), oneof) +import Test.QuickCheck (Arbitrary(..)) instance Arbitrary CallStack where +# if MIN_VERSION_base(4,9,0) arbitrary = oneof [ pure EmptyCallStack , PushCallStack <$> arbitrary <*> arbitrary <@> EmptyCallStack , pure $ FreezeCallStack EmptyCallStack ] +# else + arbitrary = genericArbitrary +# endif instance Arbitrary SrcLoc where - arbitrary = SrcLoc <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary + arbitrary = genericArbitrary + +# if !(MIN_VERSION_base(4,9,0)) +$(Generics.deriveAll0 ''CallStack) +# endif +$(Generics.deriveAll0 ''SrcLoc) #endif diff --git a/tests/Instances/GHC/StaticPtr.hs b/tests/Instances/GHC/StaticPtr.hs --- a/tests/Instances/GHC/StaticPtr.hs +++ b/tests/Instances/GHC/StaticPtr.hs @@ -1,9 +1,14 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} + +#if MIN_VERSION_base(4,8,0) +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +#endif {-| Module: Instances.GHC.StaticPtr -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -14,14 +19,14 @@ module Instances.GHC.StaticPtr () where #if MIN_VERSION_base(4,8,0) +import GHC.Generics (Generic) import GHC.StaticPtr (StaticPtrInfo(..)) + +import Instances.Utils.GenericArbitrary (genericArbitrary) + import Test.QuickCheck (Arbitrary(..)) +deriving instance Generic StaticPtrInfo instance Arbitrary StaticPtrInfo where - arbitrary = StaticPtrInfo <$> arbitrary - <*> arbitrary - <*> arbitrary -# if __GLASGOW_HASKELL__ < 801 - <*> arbitrary -# endif + arbitrary = genericArbitrary #endif diff --git a/tests/Instances/GHC/Stats.hs b/tests/Instances/GHC/Stats.hs --- a/tests/Instances/GHC/Stats.hs +++ b/tests/Instances/GHC/Stats.hs @@ -1,9 +1,15 @@ -{-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# 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 -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -14,21 +20,14 @@ module Instances.GHC.Stats () where #if MIN_VERSION_base(4,5,0) +import GHC.Generics (Generic) import GHC.Stats (GCStats(..)) -import Prelude () -import Prelude.Compat +import Instances.Utils.GenericArbitrary (genericArbitrary) import Test.QuickCheck (Arbitrary(..)) +deriving instance Generic GCStats instance Arbitrary GCStats where - arbitrary = GCStats <$> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary - <*> arbitrary <*> arbitrary <*> arbitrary -# if __GLASGOW_HASKELL__ >= 801 - <*> arbitrary -# endif + arbitrary = genericArbitrary #endif diff --git a/tests/Instances/GHC/TypeLits.hs b/tests/Instances/GHC/TypeLits.hs --- a/tests/Instances/GHC/TypeLits.hs +++ b/tests/Instances/GHC/TypeLits.hs @@ -8,7 +8,7 @@ {-| Module: Instances.GHC.TypeLits -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional diff --git a/tests/Instances/Generic.hs b/tests/Instances/Generic.hs --- a/tests/Instances/Generic.hs +++ b/tests/Instances/Generic.hs @@ -2,7 +2,7 @@ {-| Module: Instances.Generic -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -13,13 +13,11 @@ module Instances.Generic () where import Instances.Data.Text () - -import Prelude () -import Prelude.Compat +import Instances.Utils.GenericArbitrary (genericArbitrary) -import Test.QuickCheck (Arbitrary(..), oneof) +import Test.QuickCheck (Arbitrary(..)) import TextShow.Generic (ConType(..)) instance Arbitrary ConType where - arbitrary = oneof [pure Rec, pure Tup, pure Pref, Inf <$> arbitrary] + arbitrary = genericArbitrary diff --git a/tests/Instances/Options.hs b/tests/Instances/Options.hs --- a/tests/Instances/Options.hs +++ b/tests/Instances/Options.hs @@ -4,7 +4,7 @@ {-| Module: Instances.Options -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional diff --git a/tests/Instances/System/Exit.hs b/tests/Instances/System/Exit.hs --- a/tests/Instances/System/Exit.hs +++ b/tests/Instances/System/Exit.hs @@ -2,7 +2,7 @@ {-| Module: Instances.System.Exit -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -12,12 +12,11 @@ -} module Instances.System.Exit () where -import Prelude () -import Prelude.Compat - +import Data.Orphans () +import Generics.Deriving.Base () +import Instances.Utils.GenericArbitrary (genericArbitrary) import System.Exit (ExitCode(..)) - -import Test.QuickCheck (Arbitrary(..), oneof) +import Test.QuickCheck (Arbitrary(..)) instance Arbitrary ExitCode where - arbitrary = oneof [pure ExitSuccess, ExitFailure <$> arbitrary] + 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,10 +1,17 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE DeriveGeneric #-} +#endif + {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.System.IO -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -14,36 +21,41 @@ -} 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(..)) +import GHC.IO.Encoding.Failure (CodingFailureMode(..)) +import GHC.IO.Encoding.Types (CodingProgress(..)) #endif -import GHC.IO.Handle (HandlePosn(..)) +import GHC.IO.Handle (HandlePosn(..)) -import Prelude () -import Prelude.Compat +import Instances.Utils.GenericArbitrary (genericArbitrary) -import System.IO (BufferMode(..), IOMode(..), Newline(..), NewlineMode(..), - SeekMode(..), Handle, stdin, stdout, stderr) +import Prelude () +import Prelude.Compat -import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum, oneof) +import System.IO (BufferMode(..), IOMode(..), Newline(..), NewlineMode(..), + SeekMode(..), Handle, stdin, stdout, stderr) +import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum, oneof) + instance Arbitrary Handle where arbitrary = oneof $ map pure [stdin, stdout, stderr] instance Arbitrary HandlePosn where - arbitrary = HandlePosn <$> arbitrary <*> arbitrary + arbitrary = genericArbitrary deriving instance Bounded IOMode instance Arbitrary IOMode where arbitrary = arbitraryBoundedEnum instance Arbitrary BufferMode where - arbitrary = oneof [ pure NoBuffering - , pure LineBuffering - , BlockBuffering <$> arbitrary - ] + arbitrary = genericArbitrary deriving instance Bounded SeekMode instance Arbitrary SeekMode where @@ -67,4 +79,14 @@ arbitrary = arbitraryBoundedEnum instance Arbitrary NewlineMode where - arbitrary = NewlineMode <$> arbitrary <*> arbitrary + 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 @@ -6,7 +6,7 @@ {-| Module: Instances.System.Posix.Types -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -17,6 +17,7 @@ module Instances.System.Posix.Types () where import Instances.Foreign.C.Types () +import Instances.Foreign.Ptr () import System.Posix.Types import Test.QuickCheck (Arbitrary(..)) @@ -120,6 +121,40 @@ # if defined(HTYPE_RLIM_T) instance Arbitrary CRLim where arbitrary = arbitrarySizedBoundedIntegral +# endif +#endif + +#if MIN_VERSION_base(4,10,0) +# if defined(HTYPE_BLKSIZE_T) +deriving instance Arbitrary CBlkSize +# endif + +# if defined(HTYPE_BLKCNT_T) +deriving instance Arbitrary CBlkCnt +# endif + +# if defined(HTYPE_CLOCKID_T) +deriving instance Arbitrary CClockId +# endif + +# if defined(HTYPE_FSBLKCNT_T) +deriving instance Arbitrary CFsBlkCnt +# endif + +# if defined(HTYPE_FSFILCNT_T) +deriving instance Arbitrary CFsFilCnt +# endif + +# if defined(HTYPE_ID_T) +deriving instance Arbitrary CId +# endif + +# if defined(HTYPE_KEY_T) +deriving instance Arbitrary CKey +# endif + +# if defined(HTYPE_TIMER_T) +deriving instance Arbitrary CTimer # endif #endif diff --git a/tests/Instances/Text/Read.hs b/tests/Instances/Text/Read.hs --- a/tests/Instances/Text/Read.hs +++ b/tests/Instances/Text/Read.hs @@ -1,9 +1,18 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeSynonymInstances #-} + +#if __GLASGOW_HASKELL__ >= 706 +{-# LANGUAGE DataKinds #-} +#endif + {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Module: Instances.Text.Read -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -13,53 +22,32 @@ -} module Instances.Text.Read () where -import Prelude () -import Prelude.Compat - -import Test.QuickCheck (Arbitrary(..), oneof) - -import Text.Read (Lexeme(..)) +import qualified Generics.Deriving.TH as Generics (deriveAll0) +import Instances.Utils.GenericArbitrary (genericArbitrary) +import Test.QuickCheck (Arbitrary(..)) +import Text.Read (Lexeme(..)) -#if MIN_VERSION_base(4,7,0) -import Data.Fixed (Fixed, E12) -import Numeric (showEFloat, showFFloat, showGFloat, showHex, showOct) -import Test.QuickCheck (Gen, getNonNegative) -import Text.Read.Lex (Number) +#if MIN_VERSION_base(4,6,0) +import Language.Haskell.TH.Lib (conT) +import TextShow.TH.Names (numberTypeName) #endif instance Arbitrary Lexeme where - arbitrary = oneof [ Char <$> arbitrary - , String <$> arbitrary - , Punc <$> arbitrary - , Ident <$> arbitrary - , Symbol <$> arbitrary -#if MIN_VERSION_base(4,7,0) - , Number <$> arbitrary -#elif !(MIN_VERSION_base(4,6,0)) - , Int <$> arbitrary - , Rat <$> arbitrary + arbitrary = genericArbitrary + +#if MIN_VERSION_base(4,6,0) +-- NB: Don't attempt to define +-- +-- type Number' = $(conT numberTypeName) +-- +-- here. Sadly, due to a bizarre GHC 7.6 bug, it'll think it's a recursive +-- type synonym and reject it. + +instance Arbitrary $(conT numberTypeName) where + arbitrary = genericArbitrary #endif - , pure EOF - ] - -#if MIN_VERSION_base(4,7,0) -instance Arbitrary Number where - arbitrary = do - str <- oneof [ show <$> (nonneg :: Gen Double) - , fmap (\d -> showEFloat Nothing d "") (nonneg :: Gen Double) - , fmap (\d -> showFFloat Nothing d "") (nonneg :: Gen Double) - , fmap (\d -> showGFloat Nothing d "") (nonneg :: Gen Double) - , show <$> (nonneg :: Gen Float) - , show <$> (nonneg :: Gen Int) - , fmap (\i -> "0x" ++ showHex i "") (nonneg :: Gen Int) - , fmap (\i -> "0o" ++ showOct i "") (nonneg :: Gen Int) - , show <$> (nonneg :: Gen Integer) - , show <$> (nonneg :: Gen Word) - , show <$> (nonneg :: Gen (Fixed E12)) - ] - let Number num = read str - pure num - where - nonneg :: (Arbitrary a, Num a, Ord a) => Gen a - nonneg = getNonNegative <$> arbitrary + +$(Generics.deriveAll0 ''Lexeme) +#if MIN_VERSION_base(4,6,0) +$(Generics.deriveAll0 numberTypeName) #endif diff --git a/tests/Instances/Utils.hs b/tests/Instances/Utils.hs --- a/tests/Instances/Utils.hs +++ b/tests/Instances/Utils.hs @@ -1,6 +1,6 @@ {-| -Module: Properties.Instances -Copyright: (C) 2014-2016 Ryan Scott +Module: Instances.Utils +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional diff --git a/tests/Instances/Utils/GenericArbitrary.hs b/tests/Instances/Utils/GenericArbitrary.hs new file mode 100644 --- /dev/null +++ b/tests/Instances/Utils/GenericArbitrary.hs @@ -0,0 +1,147 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeSynonymInstances #-} + +{-| +Module: Instances.Utils.GenericArbitrary +Copyright: (C) 2014-2017 Ryan Scott +License: BSD-style (see the file LICENSE) +Maintainer: Ryan Scott +Stability: Provisional +Portability: GHC + +A generic default implemention of 'arbitrary'. + +Ideally, this should be a part of @QuickCheck@ itself +(see https://github.com/nick8325/quickcheck/pull/40), but alas, it hasn't been +merged yet. Until then, we'll have to define it ourselves. +-} +module Instances.Utils.GenericArbitrary (genericArbitrary) where + +import Generics.Deriving.Base + +import GHC.Exts (Char(..), Double(..), Float(..), Int(..), Word(..)) + +import Prelude () +import Prelude.Compat + +import Test.QuickCheck (Arbitrary(..), Gen, choose) + +-- | `Gen` for generic instances in which each constructor has equal probability +-- of being chosen. +genericArbitrary :: (Generic a, GArbitrary (Rep a)) => Gen a +genericArbitrary = to <$> gArbitrary + +class GArbitrary f where + gArbitrary :: Gen (f a) + +instance GArbitrary V1 where + -- Following the `Encode' V1` example in GHC.Generics. + gArbitrary = undefined + +instance GArbitrary U1 where + gArbitrary = return U1 + +instance (GArbitrary a, GArbitrary b) => GArbitrary (a :*: b) where + gArbitrary = (:*:) <$> gArbitrary <*> gArbitrary + +instance ( SumSize a, SumSize b + , ChooseSum a, ChooseSum b ) => GArbitrary (a :+: b) where + gArbitrary = do + -- We cannot simply choose with equal probability between the left and + -- right part of the `a :+: b` (e.g. with `choose (False, True)`), + -- because GHC.Generics does not guarantee :+: to be balanced; even if it + -- did, it could only do so for sum types with 2^n alternatives. + -- If we did that and got a data structure of form `(a :+: (b :+: c))`, + -- then a would be chosen just as often as b and c together. + -- So we first have to compute the number of alternatives using `sumSize`, + -- and then uniformly sample a number in the corresponding range. + let size = unTagged2 (sumSize :: Tagged2 (a :+: b) Int) + x <- choose (1, size) + -- Optimisation: + -- We could just recursively call `gArbitrary` on the left orright branch + -- here, as in + -- if x <= sizeL + -- then L1 <$> gArbitrary + -- else R1 <$> gArbitrary + -- but this would unnecessarily sample again in the same sum type, and that + -- even though `x` completely determines which alternative to choose, + -- and sampling is slow because it needs IO and random numbers. + -- So instead we use `chooseSum x` to pick the x'th alternative from the + -- current sum type. + -- This made it around 50% faster for a sum type with 26 alternatives + -- on my computer. + chooseSum x + +instance GArbitrary a => GArbitrary (M1 i c a) where + gArbitrary = M1 <$> gArbitrary + +instance Arbitrary a => GArbitrary (K1 i a) where + gArbitrary = K1 <$> arbitrary + +instance GArbitrary UChar where + gArbitrary = do + C# c <- arbitrary + return (UChar c) + +instance GArbitrary UDouble where + gArbitrary = do + D# d <- arbitrary + return (UDouble d) + +instance GArbitrary UFloat where + gArbitrary = do + F# f <- arbitrary + return (UFloat f) + +instance GArbitrary UInt where + gArbitrary = do + I# i <- arbitrary + return (UInt i) + +instance GArbitrary UWord where + gArbitrary = do + W# w <- arbitrary + return (UWord w) + +newtype Tagged2 (s :: * -> *) b = Tagged2 {unTagged2 :: b} + +-- | Calculates the size of a sum type (numbers of alternatives). +-- +-- Example: `data X = A | B | C` has `sumSize` 3. +class SumSize f where + sumSize :: Tagged2 f Int + +-- Recursive case: Sum split `(:+:)`.. +instance (SumSize a, SumSize b) => SumSize (a :+: b) where + sumSize = Tagged2 $ unTagged2 (sumSize :: Tagged2 a Int) + + unTagged2 (sumSize :: Tagged2 b Int) + {-# INLINE sumSize #-} + +-- Constructor base case. +instance SumSize (C1 s a) where + sumSize = Tagged2 1 + {-# INLINE sumSize #-} + +-- | This class takes an integer `x` and returns a `gArbitrary` value +-- for the `x`'th alternative in a sum type. +class ChooseSum f where + chooseSum :: Int -> Gen (f a) + +-- Recursive case: Check whether `x` lies in the left or the right side +-- of the (:+:) split. +instance (SumSize a, ChooseSum a, ChooseSum b) => ChooseSum (a :+: b) where + chooseSum x = do + let sizeL = unTagged2 (sumSize :: Tagged2 a Int) + if x <= sizeL + then L1 <$> chooseSum x + else R1 <$> chooseSum (x - sizeL) + +-- Constructor base case. +instance (GArbitrary a) => ChooseSum (C1 s a) where + chooseSum 1 = gArbitrary + chooseSum _ = error "chooseSum: BUG" diff --git a/tests/Spec/BuilderSpec.hs b/tests/Spec/BuilderSpec.hs --- a/tests/Spec/BuilderSpec.hs +++ b/tests/Spec/BuilderSpec.hs @@ -1,6 +1,6 @@ {-| Module: Spec.BuilderSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional diff --git a/tests/Spec/Control/ApplicativeSpec.hs b/tests/Spec/Control/ApplicativeSpec.hs --- a/tests/Spec/Control/ApplicativeSpec.hs +++ b/tests/Spec/Control/ApplicativeSpec.hs @@ -1,6 +1,6 @@ {-| Module: Spec.Control.ApplicativeSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -14,14 +14,14 @@ import Control.Monad.Trans.Instances () import Data.Orphans () +import Data.Proxy (Proxy(..)) import Generics.Deriving.Instances () -import Spec.Utils (prop_matchesTextShow, prop_matchesTextShow1, - prop_genericTextShow, prop_genericTextShow1) +import Spec.Utils (matchesTextShowSpec, matchesTextShow1Spec, + genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec @@ -29,8 +29,10 @@ spec :: Spec spec = parallel $ do describe "Const Int Int" $ - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> Const Int Int -> Bool) + matchesTextShow1Spec (Proxy :: Proxy (Const Int Int)) describe "ZipList Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> ZipList Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> ZipList Int -> Bool) - prop "generic TextShow1" (prop_genericTextShow1 :: Int -> ZipList Int -> Bool) + let p :: Proxy (ZipList Int) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p + genericTextShow1Spec p diff --git a/tests/Spec/Control/ConcurrentSpec.hs b/tests/Spec/Control/ConcurrentSpec.hs --- a/tests/Spec/Control/ConcurrentSpec.hs +++ b/tests/Spec/Control/ConcurrentSpec.hs @@ -1,6 +1,6 @@ {-| Module: Spec.Control.ConcurrentSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -12,6 +12,8 @@ import Control.Concurrent (myThreadId) +import Data.Proxy (Proxy(..)) + import GHC.Conc (BlockReason, ThreadStatus) import Instances.Control.Concurrent () @@ -19,7 +21,7 @@ import Prelude () import Prelude.Compat -import Spec.Utils (prop_matchesTextShow) +import Spec.Utils (matchesTextShowSpec, prop_matchesTextShow) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) @@ -31,11 +33,11 @@ spec :: Spec spec = parallel $ do describe "BlockReason" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> BlockReason -> Bool) + matchesTextShowSpec (Proxy :: Proxy BlockReason) describe "ThreadId" $ prop "TextShow instance" prop_showThreadId describe "ThreadStatus" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> ThreadStatus -> Bool) + matchesTextShowSpec (Proxy :: Proxy ThreadStatus) -- | Verifies the 'Show' instance for 'ThreadId' is accurate. prop_showThreadId :: Int -> Property diff --git a/tests/Spec/Control/ExceptionSpec.hs b/tests/Spec/Control/ExceptionSpec.hs --- a/tests/Spec/Control/ExceptionSpec.hs +++ b/tests/Spec/Control/ExceptionSpec.hs @@ -2,7 +2,7 @@ {-| Module: Spec.Control.ExceptionSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -13,13 +13,10 @@ module Spec.Control.ExceptionSpec (main, spec) where import Control.Exception - +import Data.Proxy (Proxy(..)) import Instances.Control.Exception () - -import Spec.Utils (prop_matchesTextShow) - +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec @@ -27,50 +24,54 @@ spec :: Spec spec = parallel . describe "TextShow.Control.Exception" $ do describe "SomeException" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> SomeException -> Bool) + matchesTextShowSpec (Proxy :: Proxy SomeException) describe "IOException" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> IOException -> Bool) + matchesTextShowSpec (Proxy :: Proxy IOException) describe "ArithException" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> ArithException -> Bool) + matchesTextShowSpec (Proxy :: Proxy ArithException) describe "ArrayException" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> ArrayException -> Bool) + matchesTextShowSpec (Proxy :: Proxy ArrayException) describe "AssertionFailed" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> AssertionFailed -> Bool) + matchesTextShowSpec (Proxy :: Proxy AssertionFailed) #if MIN_VERSION_base(4,7,0) describe "SomeAsyncException" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> SomeAsyncException -> Bool) + matchesTextShowSpec (Proxy :: Proxy SomeAsyncException) #endif describe "AsyncException" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> AsyncException -> Bool) + matchesTextShowSpec (Proxy :: Proxy AsyncException) describe "NonTermination" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> NonTermination -> Bool) + matchesTextShowSpec (Proxy :: Proxy NonTermination) describe "NestedAtomically" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> NestedAtomically -> Bool) + matchesTextShowSpec (Proxy :: Proxy NestedAtomically) describe "BlockedIndefinitelyOnMVar" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> BlockedIndefinitelyOnMVar -> Bool) + matchesTextShowSpec (Proxy :: Proxy BlockedIndefinitelyOnMVar) describe "BlockedIndefinitelyOnSTM" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> BlockedIndefinitelyOnSTM -> Bool) + matchesTextShowSpec (Proxy :: Proxy BlockedIndefinitelyOnSTM) #if MIN_VERSION_base(4,8,0) describe "AllocationLimitExceeded" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> AllocationLimitExceeded -> Bool) + matchesTextShowSpec (Proxy :: Proxy AllocationLimitExceeded) #endif #if MIN_VERSION_base(4,9,0) describe "TypeError" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> TypeError -> Bool) + matchesTextShowSpec (Proxy :: Proxy TypeError) #endif +#if MIN_VERSION_base(4,10,0) + describe "CompactionFailed" $ + matchesTextShowSpec (Proxy :: Proxy CompactionFailed) +#endif describe "Deadlock" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Deadlock -> Bool) + matchesTextShowSpec (Proxy :: Proxy Deadlock) describe "NoMethodError" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> NoMethodError -> Bool) + matchesTextShowSpec (Proxy :: Proxy NoMethodError) describe "PatternMatchFail" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> PatternMatchFail -> Bool) + matchesTextShowSpec (Proxy :: Proxy PatternMatchFail) describe "RecConError" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> RecConError -> Bool) + matchesTextShowSpec (Proxy :: Proxy RecConError) describe "RecSelError" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> RecSelError -> Bool) + matchesTextShowSpec (Proxy :: Proxy RecSelError) describe "RecUpdError" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> RecUpdError -> Bool) + matchesTextShowSpec (Proxy :: Proxy RecUpdError) describe "ErrorCall" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> ErrorCall -> Bool) + matchesTextShowSpec (Proxy :: Proxy ErrorCall) describe "MaskingState" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> MaskingState -> Bool) + matchesTextShowSpec (Proxy :: Proxy MaskingState) diff --git a/tests/Spec/Control/Monad/STSpec.hs b/tests/Spec/Control/Monad/STSpec.hs --- a/tests/Spec/Control/Monad/STSpec.hs +++ b/tests/Spec/Control/Monad/STSpec.hs @@ -1,17 +1,14 @@ module Spec.Control.Monad.STSpec (main, spec) where import Control.Monad.ST - +import Data.Proxy (Proxy(..)) import Instances.Control.Monad.ST () - -import Spec.Utils (prop_matchesTextShow) - +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "ST Int Int" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> ST Int Int -> Bool) + matchesTextShowSpec (Proxy :: Proxy (ST Int Int)) diff --git a/tests/Spec/Data/ArraySpec.hs b/tests/Spec/Data/ArraySpec.hs --- a/tests/Spec/Data/ArraySpec.hs +++ b/tests/Spec/Data/ArraySpec.hs @@ -2,7 +2,7 @@ {-| Module: Spec.Data.ArraySpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -21,11 +21,11 @@ #if !defined(mingw32_HOST_OS) && MIN_VERSION_text(1,0,0) import Data.Array (Array) import Data.Array.Unboxed (UArray) +import Data.Proxy (Proxy(..)) -import Spec.Utils (prop_matchesTextShow) +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe) -import Test.Hspec.QuickCheck (prop) #endif main :: IO () @@ -36,9 +36,9 @@ #if !defined(mingw32_HOST_OS) && MIN_VERSION_text(1,0,0) -- TODO: Figure out why these tests diverge on Windows describe "Array Int Int" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Array Int Int -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Array Int Int)) describe "UArray Int Int" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> UArray Int Int -> Bool) + matchesTextShowSpec (Proxy :: Proxy (UArray Int Int)) #else pure () #endif diff --git a/tests/Spec/Data/BoolSpec.hs b/tests/Spec/Data/BoolSpec.hs --- a/tests/Spec/Data/BoolSpec.hs +++ b/tests/Spec/Data/BoolSpec.hs @@ -2,7 +2,7 @@ {-| Module: Spec.Data.BoolSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -12,15 +12,16 @@ -} module Spec.Data.BoolSpec (main, spec) where -import Spec.Utils (prop_matchesTextShow, prop_genericTextShow) - +import Data.Proxy (Proxy(..)) +import Spec.Utils (matchesTextShowSpec, genericTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Bool" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> Bool -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> Bool -> Bool) + let p :: Proxy Bool + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p diff --git a/tests/Spec/Data/ByteStringSpec.hs b/tests/Spec/Data/ByteStringSpec.hs --- a/tests/Spec/Data/ByteStringSpec.hs +++ b/tests/Spec/Data/ByteStringSpec.hs @@ -1,6 +1,6 @@ {-| Module: Spec.Data.ByteStringSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -13,13 +13,13 @@ import qualified Data.ByteString as BS (ByteString) import qualified Data.ByteString.Lazy as BL (ByteString) import Data.ByteString.Short (ShortByteString) +import Data.Proxy (Proxy(..)) import Instances.Data.ByteString () -import Spec.Utils (prop_matchesTextShow) +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) import Test.QuickCheck.Instances () main :: IO () @@ -28,8 +28,8 @@ spec :: Spec spec = parallel $ do describe "strict ByteString" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> BS.ByteString -> Bool) + matchesTextShowSpec (Proxy :: Proxy BS.ByteString) describe "lazy ByteString" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> BL.ByteString -> Bool) + matchesTextShowSpec (Proxy :: Proxy BL.ByteString) describe "ShortByteString" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> ShortByteString -> Bool) + matchesTextShowSpec (Proxy :: Proxy ShortByteString) diff --git a/tests/Spec/Data/CharSpec.hs b/tests/Spec/Data/CharSpec.hs --- a/tests/Spec/Data/CharSpec.hs +++ b/tests/Spec/Data/CharSpec.hs @@ -1,6 +1,6 @@ {-| Module: Spec.Data.CharSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -12,15 +12,15 @@ import Data.Array (elems) import Data.Char (GeneralCategory) +import Data.Proxy (Proxy(..)) import GHC.Show (asciiTab) import Instances.Data.Char () -import Spec.Utils (prop_matchesTextShow) +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, it, parallel, shouldBe) -import Test.Hspec.QuickCheck (prop) import TextShow (fromString) import TextShow.Data.Char (asciiTabB) @@ -31,8 +31,8 @@ spec :: Spec spec = parallel $ do describe "Char" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Char -> Bool) + matchesTextShowSpec (Proxy :: Proxy Char) describe "GeneralCategory" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> GeneralCategory -> Bool) + matchesTextShowSpec (Proxy :: Proxy GeneralCategory) describe "asciiTabB" $ - it "equals asciiTab" $ map fromString asciiTab `shouldBe` elems asciiTabB + it "equals asciiTab" $ map fromString asciiTab `shouldBe` elems asciiTabB diff --git a/tests/Spec/Data/ComplexSpec.hs b/tests/Spec/Data/ComplexSpec.hs --- a/tests/Spec/Data/ComplexSpec.hs +++ b/tests/Spec/Data/ComplexSpec.hs @@ -1,6 +1,6 @@ {-| Module: Spec.Data.ComplexSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -11,15 +11,15 @@ module Spec.Data.ComplexSpec (main, spec) where import Data.Complex (Complex) +import Data.Proxy (Proxy(..)) -import Spec.Utils (prop_matchesTextShow) +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Complex Double" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Complex Double -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Complex Double)) diff --git a/tests/Spec/Data/DataSpec.hs b/tests/Spec/Data/DataSpec.hs --- a/tests/Spec/Data/DataSpec.hs +++ b/tests/Spec/Data/DataSpec.hs @@ -1,6 +1,6 @@ {-| Module: Spec.Data.DataSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -11,13 +11,13 @@ module Spec.Data.DataSpec (main, spec) where import Data.Data (Constr, ConstrRep, DataRep, DataType, Fixity) +import Data.Proxy (Proxy(..)) import Instances.Data.Data () -import Spec.Utils (prop_matchesTextShow) +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec @@ -25,12 +25,12 @@ spec :: Spec spec = parallel $ do describe "Constr" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Constr -> Bool) + matchesTextShowSpec (Proxy :: Proxy Constr) describe "ConstrRep" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> ConstrRep -> Bool) + matchesTextShowSpec (Proxy :: Proxy ConstrRep) describe "DataRep" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> DataRep -> Bool) + matchesTextShowSpec (Proxy :: Proxy DataRep) describe "DataType" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> DataType -> Bool) + matchesTextShowSpec (Proxy :: Proxy DataType) describe "Fixity" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Fixity -> Bool) + matchesTextShowSpec (Proxy :: Proxy Fixity) diff --git a/tests/Spec/Data/DynamicSpec.hs b/tests/Spec/Data/DynamicSpec.hs --- a/tests/Spec/Data/DynamicSpec.hs +++ b/tests/Spec/Data/DynamicSpec.hs @@ -1,6 +1,6 @@ {-| Module: Spec.Data.DynamicSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -11,17 +11,17 @@ module Spec.Data.DynamicSpec (main, spec) where import Data.Dynamic (Dynamic) +import Data.Proxy (Proxy(..)) import Instances.Data.Dynamic () -import Spec.Utils (prop_matchesTextShow) +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Dynamic" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Dynamic -> Bool) + matchesTextShowSpec (Proxy :: Proxy Dynamic) diff --git a/tests/Spec/Data/EitherSpec.hs b/tests/Spec/Data/EitherSpec.hs --- a/tests/Spec/Data/EitherSpec.hs +++ b/tests/Spec/Data/EitherSpec.hs @@ -1,6 +1,6 @@ {-| Module: Spec.Data.EitherSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -10,18 +10,18 @@ -} module Spec.Data.EitherSpec (main, spec) where +import Data.Proxy (Proxy(..)) import Generics.Deriving.Instances () - -import Spec.Utils (prop_matchesTextShow1, prop_genericTextShow, prop_genericTextShow1) - +import Spec.Utils (matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Either Int Int" $ do - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> Either Int Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> Either Int Int -> Bool) - prop "generic TextShow1" (prop_genericTextShow1 :: Int -> Either Int Int -> Bool) + let p :: Proxy (Either Int Int) + p = Proxy + matchesTextShow1Spec p + genericTextShowSpec p + genericTextShow1Spec p diff --git a/tests/Spec/Data/FixedSpec.hs b/tests/Spec/Data/FixedSpec.hs --- a/tests/Spec/Data/FixedSpec.hs +++ b/tests/Spec/Data/FixedSpec.hs @@ -1,6 +1,6 @@ {-| Module: Spec.Data.FixedSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -11,8 +11,9 @@ module Spec.Data.FixedSpec (main, spec) where import Data.Fixed (Fixed, E0, E1, E2, E3, E6, E9, E12, showFixed) +import Data.Proxy (Proxy(..)) -import Spec.Utils (prop_matchesTextShow) +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) @@ -26,21 +27,21 @@ spec :: Spec spec = parallel $ do describe "Fixed E0" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Fixed E0 -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Fixed E0)) describe "Fixed E1" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Fixed E1 -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Fixed E1)) describe "Fixed E2" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Fixed E2 -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Fixed E2)) describe "Fixed E3" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Fixed E3 -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Fixed E3)) describe "Fixed E6" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Fixed E6 -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Fixed E6)) describe "Fixed E9" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Fixed E9 -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Fixed E9)) describe "Fixed E12" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Fixed E12 -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Fixed E12)) describe "showbFixed" $ - prop "has the same output as showFixed" prop_showFixed + prop "has the same output as showFixed" prop_showFixed -- | Verifies 'showFixed' and 'showbFixed' generate the same output. prop_showFixed :: Bool -> Fixed E12 -> Bool diff --git a/tests/Spec/Data/FloatingSpec.hs b/tests/Spec/Data/FloatingSpec.hs --- a/tests/Spec/Data/FloatingSpec.hs +++ b/tests/Spec/Data/FloatingSpec.hs @@ -2,7 +2,7 @@ {-| Module: Spec.Data.FloatingSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -12,6 +12,7 @@ -} module Spec.Data.FloatingSpec (main, spec) where +import Data.Proxy (Proxy(..)) import Data.Text.Lazy.Builder.RealFloat (FPFormat) import Instances.Data.Floating () @@ -22,7 +23,7 @@ import Prelude () import Prelude.Compat -import Spec.Utils (prop_matchesTextShow) +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) @@ -30,7 +31,7 @@ import TextShow (Builder, fromString) import TextShow.Data.Floating (showbEFloat, showbFFloat, showbGFloat, - showbFFloatAlt, showbGFloatAlt) + showbFFloatAlt, showbGFloatAlt) main :: IO () main = hspec spec @@ -38,21 +39,21 @@ spec :: Spec spec = parallel $ do describe "Float" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Float -> Bool) + matchesTextShowSpec (Proxy :: Proxy Float) describe "Double" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Double -> Bool) + matchesTextShowSpec (Proxy :: Proxy Double) describe "showbEFloat" $ - prop "has the same output as showEFloat" $ prop_showXFloat showEFloat showbEFloat + prop "has the same output as showEFloat" $ prop_showXFloat showEFloat showbEFloat describe "showbFFloat" $ - prop "has the same output as showFFloat" $ prop_showXFloat showFFloat showbFFloat + prop "has the same output as showFFloat" $ prop_showXFloat showFFloat showbFFloat describe "showbGFloat" $ - prop "has the same output as showGFloat" $ prop_showXFloat showGFloat showbGFloat + prop "has the same output as showGFloat" $ prop_showXFloat showGFloat showbGFloat describe "showbFFloatAlt" $ - prop "has the same output as showFFloatAlt" $ prop_showXFloat showFFloatAlt showbFFloatAlt + prop "has the same output as showFFloatAlt" $ prop_showXFloat showFFloatAlt showbFFloatAlt describe "showbGFloatAlt" $ - prop "has the same output as showFFloatAlt" $ prop_showXFloat showGFloatAlt showbGFloatAlt + prop "has the same output as showFFloatAlt" $ prop_showXFloat showGFloatAlt showbGFloatAlt describe "FPFormat" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> FPFormat -> Bool) + matchesTextShowSpec (Proxy :: Proxy FPFormat) -- | Verifies @showXFloat@ and @showbXFloat@ generate the same output (where @X@ -- is one of E, F, or G). 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 @@ -1,6 +1,6 @@ {-| Module: Spec.Data.Functor.ComposeSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -13,18 +13,17 @@ import Control.Monad.Trans.Instances () import Data.Functor.Compose (Compose) +import Data.Proxy (Proxy(..)) import Instances.Data.Functor.Compose () -import Spec.Utils (prop_matchesTextShow1) +import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Compose Maybe Maybe Int" $ - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> Compose Maybe Maybe Int -> Bool) - + matchesTextShow1Spec (Proxy :: Proxy (Compose Maybe Maybe Int)) diff --git a/tests/Spec/Data/Functor/IdentitySpec.hs b/tests/Spec/Data/Functor/IdentitySpec.hs --- a/tests/Spec/Data/Functor/IdentitySpec.hs +++ b/tests/Spec/Data/Functor/IdentitySpec.hs @@ -1,6 +1,6 @@ {-| Module: Spec.Data.Functor.IdentitySpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -13,15 +13,15 @@ import Control.Monad.Trans.Instances () import Data.Functor.Identity (Identity) +import Data.Proxy (Proxy(..)) -import Spec.Utils (prop_matchesTextShow1) +import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Identity Int" $ - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> Identity Int -> Bool) + matchesTextShow1Spec (Proxy :: Proxy (Identity Int)) 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 @@ -1,6 +1,6 @@ {-| Module: Spec.Data.Functor.ProductSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -13,17 +13,17 @@ import Control.Monad.Trans.Instances () import Data.Functor.Product (Product) +import Data.Proxy (Proxy(..)) import Instances.Data.Functor.Product () -import Spec.Utils (prop_matchesTextShow1) +import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Product Maybe Maybe Int" $ - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> Product Maybe Maybe Int -> Bool) + matchesTextShow1Spec (Proxy :: Proxy (Product Maybe Maybe Int)) 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 @@ -1,6 +1,6 @@ {-| Module: Spec.Data.Functor.SumSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -13,18 +13,17 @@ import Control.Monad.Trans.Instances () import Data.Functor.Sum (Sum) +import Data.Proxy (Proxy(..)) import Instances.Data.Functor.Sum () -import Spec.Utils (prop_matchesTextShow1) +import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Sum Maybe Maybe Int" $ - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> Sum Maybe Maybe Int -> Bool) - + matchesTextShow1Spec (Proxy :: Proxy (Sum Maybe Maybe Int)) diff --git a/tests/Spec/Data/IntegralSpec.hs b/tests/Spec/Data/IntegralSpec.hs --- a/tests/Spec/Data/IntegralSpec.hs +++ b/tests/Spec/Data/IntegralSpec.hs @@ -2,7 +2,7 @@ {-| Module: Spec.Data.IntegralSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -13,21 +13,25 @@ module Spec.Data.IntegralSpec (main, spec) where import Data.Int (Int8, Int16, Int32, Int64) +import Data.Proxy (Proxy(..)) import Data.Word (Word8, Word16, Word32, Word64) import Prelude () import Prelude.Compat -import Spec.Utils (prop_matchesTextShow) +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) #if !defined(mingw32_HOST_OS) && MIN_VERSION_text(1,0,0) import Control.Applicative (liftA2) + import Data.Char (intToDigit) + import Numeric (showIntAtBase) + import Test.QuickCheck (Gen, arbitrary, getNonNegative, suchThat) +import Test.Hspec.QuickCheck (prop) import TextShow (fromString) import TextShow.Data.Integral (showbIntAtBase) @@ -39,27 +43,27 @@ spec :: Spec spec = parallel $ do describe "Int" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Int -> Bool) + matchesTextShowSpec (Proxy :: Proxy Int) describe "Int8" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Int8 -> Bool) + matchesTextShowSpec (Proxy :: Proxy Int8) describe "Int16" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Int16 -> Bool) + matchesTextShowSpec (Proxy :: Proxy Int16) describe "Int32" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Int32 -> Bool) + matchesTextShowSpec (Proxy :: Proxy Int32) describe "Int64" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Int64 -> Bool) + matchesTextShowSpec (Proxy :: Proxy Int64) describe "Integer" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Integer -> Bool) + matchesTextShowSpec (Proxy :: Proxy Integer) describe "Word" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Word -> Bool) + matchesTextShowSpec (Proxy :: Proxy Word) describe "Word8" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Word8 -> Bool) + matchesTextShowSpec (Proxy :: Proxy Word8) describe "Word16" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Word16 -> Bool) + matchesTextShowSpec (Proxy :: Proxy Word16) describe "Word32" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Word32 -> Bool) + matchesTextShowSpec (Proxy :: Proxy Word32) describe "Word64" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Word64 -> Bool) + matchesTextShowSpec (Proxy :: Proxy Word64) #if !defined(mingw32_HOST_OS) && MIN_VERSION_text(1,0,0) -- TODO: Figure out why this diverges on Windows describe "showbIntAtBase" $ 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 @@ -1,6 +1,6 @@ {-| Module: Spec.Data.List.NonEmptySpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -10,18 +10,15 @@ -} module Spec.Data.List.NonEmptySpec (main, spec) where +import Data.Proxy (Proxy(..)) import Data.List.NonEmpty (NonEmpty) - -import Instances.Data.List.NonEmpty () - -import Spec.Utils (prop_matchesTextShow1) - +import Data.Orphans () +import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "NonEmpty Int" $ - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> NonEmpty Int -> Bool) + matchesTextShow1Spec (Proxy :: Proxy (NonEmpty Int)) diff --git a/tests/Spec/Data/ListSpec.hs b/tests/Spec/Data/ListSpec.hs --- a/tests/Spec/Data/ListSpec.hs +++ b/tests/Spec/Data/ListSpec.hs @@ -1,6 +1,6 @@ {-| Module: Spec.Data.ListSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -10,8 +10,10 @@ -} module Spec.Data.ListSpec (main, spec) where -import Spec.Utils (prop_matchesTextShow) +import Data.Proxy (Proxy(..)) +import Spec.Utils (matchesTextShowSpec) + import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) @@ -25,13 +27,13 @@ spec :: Spec spec = parallel $ do describe "String" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> String -> Bool) + matchesTextShowSpec (Proxy :: Proxy String) describe "[String]" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> [String] -> Bool) + matchesTextShowSpec (Proxy :: Proxy [String]) describe "[Int]" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> [Int] -> Bool) + matchesTextShowSpec (Proxy :: Proxy [Int]) describe "showbListWith" $ - prop "has the same output as showListWith" prop_showListWith + prop "has the same output as showListWith" prop_showListWith -- | Verifies 'showListWith' and 'showbListWith' generate the same output. prop_showListWith :: String -> Bool diff --git a/tests/Spec/Data/MaybeSpec.hs b/tests/Spec/Data/MaybeSpec.hs --- a/tests/Spec/Data/MaybeSpec.hs +++ b/tests/Spec/Data/MaybeSpec.hs @@ -1,6 +1,6 @@ {-| Module: Spec.Data.MaybeSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -11,17 +11,19 @@ module Spec.Data.MaybeSpec (main, spec) where import Data.Orphans () +import Data.Proxy (Proxy(..)) -import Spec.Utils (prop_matchesTextShow1, prop_genericTextShow, prop_genericTextShow1) +import Spec.Utils (matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Maybe Int" $ do - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> Maybe Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> Maybe Int -> Bool) - prop "generic TextShow1" (prop_genericTextShow1 :: Int -> Maybe Int -> Bool) + let p :: Proxy (Maybe Int) + p = Proxy + matchesTextShow1Spec p + genericTextShowSpec p + genericTextShow1Spec p diff --git a/tests/Spec/Data/MonoidSpec.hs b/tests/Spec/Data/MonoidSpec.hs --- a/tests/Spec/Data/MonoidSpec.hs +++ b/tests/Spec/Data/MonoidSpec.hs @@ -2,7 +2,7 @@ {-| Module: Spec.Data.MonoidSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -13,13 +13,13 @@ module Spec.Data.MonoidSpec (main, spec) where import Data.Monoid +import Data.Proxy (Proxy(..)) import Generics.Deriving.Instances () -import Spec.Utils (prop_matchesTextShow, prop_genericTextShow, prop_genericTextShow1) +import Spec.Utils (matchesTextShowSpec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec @@ -27,34 +27,50 @@ spec :: Spec spec = parallel $ do describe "All" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> All -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> All -> Bool) + let p :: Proxy All + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p describe "Any" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> Any -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> Any -> Bool) + let p :: Proxy Any + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p describe "Dual Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> Dual Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> Dual Int -> Bool) - prop "generic TextShow1" (prop_genericTextShow1 :: Int -> Dual Int -> Bool) + let p :: Proxy (Dual Int) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p + genericTextShow1Spec p describe "First Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> First Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> First Int -> Bool) - prop "generic TextShow1" (prop_genericTextShow1 :: Int -> First Int -> Bool) + let p :: Proxy (First Int) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p + genericTextShow1Spec p describe "Last Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> Last Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> Last Int -> Bool) - prop "generic TextShow1" (prop_genericTextShow1 :: Int -> Last Int -> Bool) + let p :: Proxy (Last Int) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p + genericTextShow1Spec p describe "Product Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> Product Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> Product Int -> Bool) - prop "generic TextShow1" (prop_genericTextShow1 :: Int -> Product Int -> Bool) + let p :: Proxy (Product Int) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p + genericTextShow1Spec p describe "Sum Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> Sum Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> Sum Int -> Bool) - prop "generic TextShow1" (prop_genericTextShow1 :: Int -> Sum Int -> Bool) + let p :: Proxy (Sum Int) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p + genericTextShow1Spec p #if MIN_VERSION_base(4,8,0) describe "Alt Maybe Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> Alt Maybe Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> Alt Maybe Int -> Bool) - prop "generic TextShow1" (prop_genericTextShow1 :: Int -> Alt Maybe Int -> Bool) + let p :: Proxy (Alt Maybe Int) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p + genericTextShow1Spec p #endif diff --git a/tests/Spec/Data/OldTypeableSpec.hs b/tests/Spec/Data/OldTypeableSpec.hs --- a/tests/Spec/Data/OldTypeableSpec.hs +++ b/tests/Spec/Data/OldTypeableSpec.hs @@ -6,7 +6,7 @@ {-| Module: Spec.Data.OldTypeableSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -25,11 +25,11 @@ #if MIN_VERSION_base(4,7,0) && !(MIN_VERSION_base(4,8,0)) import Data.OldTypeable (TyCon, TypeRep) +import Data.Proxy (Proxy(..)) -import Spec.Utils (prop_matchesTextShow) +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe) -import Test.Hspec.QuickCheck (prop) #endif main :: IO () @@ -39,9 +39,9 @@ spec = parallel $ do #if MIN_VERSION_base(4,7,0) && !(MIN_VERSION_base(4,8,0)) describe "TypeRep" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> TypeRep -> Bool) + matchesTextShowSpec (Proxy :: Proxy TypeRep) describe "TyCon" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> TyCon -> Bool) + matchesTextShowSpec (Proxy :: Proxy TyCon) #else pure () #endif diff --git a/tests/Spec/Data/OrdSpec.hs b/tests/Spec/Data/OrdSpec.hs --- a/tests/Spec/Data/OrdSpec.hs +++ b/tests/Spec/Data/OrdSpec.hs @@ -1,6 +1,6 @@ {-| Module: Spec.Data.OrdSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -11,6 +11,7 @@ module Spec.Data.OrdSpec (main, spec) where import Data.Orphans () +import Data.Proxy (Proxy(..)) import Generics.Deriving.Instances () @@ -18,10 +19,9 @@ import Instances.Data.Ord () -import Spec.Utils (prop_matchesTextShow, prop_genericTextShow) +import Spec.Utils (matchesTextShowSpec, genericTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec @@ -29,7 +29,9 @@ spec :: Spec spec = parallel $ do describe "Ordering" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> Ordering -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> Ordering -> Bool) + let p :: Proxy Ordering + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p describe "Down Int" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Down Int -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Down Int)) 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 @@ -1,8 +1,6 @@ -{-# LANGUAGE CPP #-} - {-| Module: Spec.Data.ProxySpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -12,24 +10,18 @@ -} module Spec.Data.ProxySpec (main, spec) where -import Data.Proxy (Proxy) - +import Data.Proxy (Proxy(..)) +import Generics.Deriving.Base () import Instances.Data.Proxy () - -import Spec.Utils (prop_matchesTextShow) -#if __GLASGOW_HASKELL__ >= 702 -import Spec.Utils (prop_genericTextShow) -#endif - +import Spec.Utils (matchesTextShowSpec, genericTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Proxy Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> Proxy Int -> Bool) -#if __GLASGOW_HASKELL__ >= 702 - prop "generic TextShow" (prop_genericTextShow :: Int -> Proxy Int -> Bool) -#endif + let p :: Proxy (Proxy Int) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p diff --git a/tests/Spec/Data/RatioSpec.hs b/tests/Spec/Data/RatioSpec.hs --- a/tests/Spec/Data/RatioSpec.hs +++ b/tests/Spec/Data/RatioSpec.hs @@ -1,6 +1,6 @@ {-| Module: Spec.Data.RatioSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -10,16 +10,16 @@ -} module Spec.Data.RatioSpec (main, spec) where +import Data.Proxy (Proxy(..)) import Data.Ratio (Ratio) -import Spec.Utils (prop_matchesTextShow) +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Ratio Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> Ratio Int -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Ratio Int)) 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 @@ -1,6 +1,6 @@ {-| Module: Spec.Data.SemigroupSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -10,14 +10,14 @@ -} module Spec.Data.SemigroupSpec (main, spec) where +import Data.Proxy (Proxy(..)) import Data.Semigroup (Min, Max, First, Last, WrappedMonoid, Option, Arg) import Instances.Data.Semigroup () -import Spec.Utils (prop_matchesTextShow) +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec @@ -25,16 +25,16 @@ spec :: Spec spec = parallel $ do describe "Min Int" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Min Int -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Min Int)) describe "Max Int" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Max Int -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Max Int)) describe "First Int" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> First Int -> Bool) + matchesTextShowSpec (Proxy :: Proxy (First Int)) describe "Last Int" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Last Int -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Last Int)) describe "WrappedMonoid ()" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> WrappedMonoid () -> Bool) + matchesTextShowSpec (Proxy :: Proxy (WrappedMonoid ())) describe "Option Int" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Option Int -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Option Int)) describe "Arg Int Char" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Arg Int Char -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Arg Int Char)) diff --git a/tests/Spec/Data/TextSpec.hs b/tests/Spec/Data/TextSpec.hs --- a/tests/Spec/Data/TextSpec.hs +++ b/tests/Spec/Data/TextSpec.hs @@ -2,7 +2,7 @@ {-| Module: Spec.Data.TextSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -12,12 +12,13 @@ -} module Spec.Data.TextSpec (main, spec) where +import Data.Proxy (Proxy(..)) + import Instances.Data.Text () -import Spec.Utils (prop_matchesTextShow) +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) import qualified Data.Text as TS import qualified Data.Text as TL @@ -37,20 +38,20 @@ spec :: Spec spec = parallel $ do describe "Builder" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Builder -> Bool) + matchesTextShowSpec (Proxy :: Proxy Builder) describe "strict Text" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> TS.Text -> Bool) + matchesTextShowSpec (Proxy :: Proxy TS.Text) describe "lazy Text" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> TL.Text -> Bool) + matchesTextShowSpec (Proxy :: Proxy TL.Text) describe "I16" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> I16 -> Bool) + matchesTextShowSpec (Proxy :: Proxy I16) describe "UnicodeException" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> UnicodeException -> Bool) + matchesTextShowSpec (Proxy :: Proxy UnicodeException) #if MIN_VERSION_text(1,0,0) describe "Decoding" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Decoding -> Bool) + matchesTextShowSpec (Proxy :: Proxy Decoding) #endif #if MIN_VERSION_text(1,1,0) describe "Size" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Size -> Bool) + matchesTextShowSpec (Proxy :: Proxy Size) #endif diff --git a/tests/Spec/Data/TupleSpec.hs b/tests/Spec/Data/TupleSpec.hs --- a/tests/Spec/Data/TupleSpec.hs +++ b/tests/Spec/Data/TupleSpec.hs @@ -1,6 +1,6 @@ {-| Module: Spec.Data.TupleSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -10,15 +10,12 @@ -} module Spec.Data.TupleSpec (main, spec) where +import Data.Proxy (Proxy(..)) import Generics.Deriving.Instances () - import Instances.Data.Tuple () - -import Spec.Utils (prop_matchesTextShow, prop_matchesTextShow1, - prop_genericTextShow, prop_genericTextShow1) - +import Spec.Utils (matchesTextShowSpec, matchesTextShow1Spec, + genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec @@ -26,73 +23,59 @@ spec :: Spec spec = parallel $ do describe "()" $ do - prop "TextShow instance" - (prop_matchesTextShow :: Int -> () -> Bool) - prop "generic TextShow" - (prop_genericTextShow :: Int -> () -> Bool) + let p :: Proxy () + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p describe "(Int, Int)" $ do - prop "TextShow1 instance" - (prop_matchesTextShow1 :: Int -> (Int, Int) -> Bool) - prop "generic TextShow" - (prop_genericTextShow :: Int -> (Int, Int) -> Bool) - prop "generic TextShow1" - (prop_genericTextShow1 :: Int -> (Int, Int) -> Bool) + let p :: Proxy (Int, Int) + p = Proxy + matchesTextShow1Spec p + genericTextShowSpec p + genericTextShow1Spec p describe "(Int, Int, Int)" $ do - prop "TextShow instance" - (prop_matchesTextShow :: Int -> (Int, Int, Int) -> Bool) - prop "generic TextShow" - (prop_genericTextShow :: Int -> (Int, Int, Int) -> Bool) - prop "generic TextShow1" - (prop_genericTextShow1 :: Int -> (Int, Int, Int) -> Bool) + let p :: Proxy (Int, Int, Int) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p + genericTextShow1Spec p describe "(Int, Int, Int, Int)" $ do - prop "TextShow instance" - (prop_matchesTextShow :: Int -> (Int, Int, Int, Int) -> Bool) - prop "generic TextShow" - (prop_genericTextShow :: Int -> (Int, Int, Int, Int) -> Bool) - prop "generic TextShow1" - (prop_genericTextShow1 :: Int -> (Int, Int, Int, Int) -> Bool) + let p :: Proxy (Int, Int, Int, Int) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p + genericTextShow1Spec p describe "(Int, Int, Int, Int, Int)" $ do - prop "TextShow instance" - (prop_matchesTextShow :: Int -> (Int, Int, Int, Int, Int) -> Bool) - prop "generic TextShow" - (prop_genericTextShow :: Int -> (Int, Int, Int, Int, Int) -> Bool) - prop "generic TextShow1" - (prop_genericTextShow1 :: Int -> (Int, Int, Int, Int, Int) -> Bool) + let p :: Proxy (Int, Int, Int, Int, Int) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p + genericTextShow1Spec p describe "(Int, Int, Int, Int, Int, Int)" $ do - prop "TextShow instance" - (prop_matchesTextShow :: Int -> (Int, Int, Int, Int, Int, Int) -> Bool) - prop "generic TextShow" - (prop_genericTextShow :: Int -> (Int, Int, Int, Int, Int, Int) -> Bool) - prop "generic TextShow1" - (prop_genericTextShow1 :: Int -> (Int, Int, Int, Int, Int, Int) -> Bool) + let p :: Proxy (Int, Int, Int, Int, Int, Int) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p + genericTextShow1Spec p describe "(Int, Int, Int, Int, Int, Int, Int)" $ do - prop "TextShow instance" - (prop_matchesTextShow :: Int -> (Int, Int, Int, Int, Int, Int, Int) -> Bool) - prop "generic TextShow" - (prop_genericTextShow :: Int -> (Int, Int, Int, Int, Int, Int, Int) -> Bool) - prop "generic TextShow1" - (prop_genericTextShow1 :: Int -> (Int, Int, Int, Int, Int, Int, Int) -> Bool) + let p :: Proxy (Int, Int, Int, Int, Int, Int, Int) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p + genericTextShow1Spec p describe "(Int, Int, Int, Int, Int, Int, Int, Int)" $ do - prop "TextShow instance" - (prop_matchesTextShow :: Int -> (Int, Int, Int, Int, Int, Int, Int, Int) -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Int, Int, Int, Int, Int, Int, Int, Int)) describe "(Int, Int, Int, Int, Int, Int, Int, Int, Int)" $ do - prop "TextShow instance" - (prop_matchesTextShow :: Int -> (Int, Int, Int, Int, Int, Int, Int, Int, Int) -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Int, Int, Int, Int, Int, Int, Int, Int, Int)) describe "(Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)" $ do - prop "TextShow instance" - (prop_matchesTextShow :: Int -> (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int) -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)) describe "(Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)" $ do - prop "TextShow instance" - (prop_matchesTextShow :: Int -> (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int) -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)) describe "(Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)" $ do - prop "TextShow instance" - (prop_matchesTextShow :: Int -> (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int) -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)) describe "(Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)" $ do - prop "TextShow instance" - (prop_matchesTextShow :: Int -> (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int) -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)) describe "(Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)" $ do - prop "TextShow instance" - (prop_matchesTextShow :: Int -> (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int) -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)) describe "(Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)" $ do - prop "TextShow instance" - (prop_matchesTextShow :: Int -> (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int) -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int)) diff --git a/tests/Spec/Data/Type/CoercionSpec.hs b/tests/Spec/Data/Type/CoercionSpec.hs --- a/tests/Spec/Data/Type/CoercionSpec.hs +++ b/tests/Spec/Data/Type/CoercionSpec.hs @@ -2,7 +2,7 @@ {-| Module: Spec.Data.Type.CoercionSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -21,12 +21,12 @@ #if MIN_VERSION_base(4,7,0) import Data.Monoid (All(..)) +import Data.Proxy (Proxy(..)) import Data.Type.Coercion (Coercion) -import Spec.Utils (prop_matchesTextShow) +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe) -import Test.Hspec.QuickCheck (prop) #endif main :: IO () @@ -36,7 +36,7 @@ spec = parallel $ #if MIN_VERSION_base(4,7,0) describe "Coercion All Bool" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Coercion All Bool -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Coercion All Bool)) #else pure () #endif diff --git a/tests/Spec/Data/Type/EqualitySpec.hs b/tests/Spec/Data/Type/EqualitySpec.hs --- a/tests/Spec/Data/Type/EqualitySpec.hs +++ b/tests/Spec/Data/Type/EqualitySpec.hs @@ -3,7 +3,7 @@ {-| Module: Spec.Data.Type.EqualitySpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -21,22 +21,28 @@ import Test.Hspec (Spec, hspec, parallel) #if MIN_VERSION_base(4,7,0) +import Data.Proxy (Proxy(..)) import Data.Type.Equality ((:~:)) - -import Spec.Utils (prop_matchesTextShow) +# if MIN_VERSION_base(4,10,0) +import Data.Type.Equality ((:~~:)) +# endif +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe) -import Test.Hspec.QuickCheck (prop) #endif main :: IO () main = hspec spec spec :: Spec -spec = parallel $ +spec = parallel $ do #if MIN_VERSION_base(4,7,0) describe "Int :~: Int" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Int :~: Int -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Int :~: Int)) +# if MIN_VERSION_base(4,10,0) + describe "Int :~~: Int" $ + matchesTextShowSpec (Proxy :: Proxy (Int :~~: Int)) +# endif #else pure () #endif diff --git a/tests/Spec/Data/TypeableSpec.hs b/tests/Spec/Data/TypeableSpec.hs --- a/tests/Spec/Data/TypeableSpec.hs +++ b/tests/Spec/Data/TypeableSpec.hs @@ -1,8 +1,12 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 706 +{-# LANGUAGE DataKinds #-} +#endif + {-| Module: Spec.Data.TypeableSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -12,31 +16,58 @@ -} module Spec.Data.TypeableSpec (main, spec) where -import Data.Typeable (TyCon, TypeRep) +import Data.Proxy (Proxy(..)) +import Data.Typeable (TyCon) #if MIN_VERSION_base(4,9,0) import GHC.Types (TrName, Module) #endif +#if MIN_VERSION_base(4,10,0) +import Data.Kind (Type) +import Type.Reflection (SomeTypeRep, TypeRep) +#else +import Data.Typeable (TypeRep) +#endif + import Instances.Data.Typeable () -import Spec.Utils (prop_matchesTextShow) +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel $ do - describe "TypeRep" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> TypeRep -> Bool) describe "TyCon" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> TyCon -> Bool) + matchesTextShowSpec (Proxy :: Proxy TyCon) #if MIN_VERSION_base(4,9,0) describe "TrName" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> TrName -> Bool) + matchesTextShowSpec (Proxy :: Proxy TrName) describe "Module" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Module -> Bool) + matchesTextShowSpec (Proxy :: Proxy Module) +#endif +#if MIN_VERSION_base(4,10,0) + describe "SomeTypeRep" $ + matchesTextShowSpec (Proxy :: Proxy SomeTypeRep) + describe "TypeRep" $ do + describe "TypeRep Type" $ + matchesTextShowSpec (Proxy :: Proxy (TypeRep Type)) + describe "TypeRep [Int]" $ + matchesTextShowSpec (Proxy :: Proxy (TypeRep [Int])) + describe "TypeRep '[Int]" $ + matchesTextShowSpec (Proxy :: Proxy (TypeRep '[Int])) + describe "TypeRep (Int, Int)" $ + matchesTextShowSpec (Proxy :: Proxy (TypeRep (Int, Int))) + describe "TypeRep '(Int, Int)" $ + matchesTextShowSpec (Proxy :: Proxy (TypeRep '(Int, Int))) + describe "TypeRep (Int -> Int)" $ + matchesTextShowSpec (Proxy :: Proxy (TypeRep (Int -> Int))) + describe "TypeRep (Either Int)" $ + matchesTextShowSpec (Proxy :: Proxy (TypeRep (Either Int))) +#else + describe "TypeRep" $ + matchesTextShowSpec (Proxy :: Proxy TypeRep) #endif diff --git a/tests/Spec/Data/VersionSpec.hs b/tests/Spec/Data/VersionSpec.hs --- a/tests/Spec/Data/VersionSpec.hs +++ b/tests/Spec/Data/VersionSpec.hs @@ -1,14 +1,15 @@ module Spec.Data.VersionSpec (main, spec) where +import Data.Proxy (Proxy(..)) import Data.Version (Version, showVersion) -import Spec.Utils (prop_matchesTextShow) +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) import TextShow (fromString) -import TextShow.Data.Version (showbVersionConcrete) +import TextShow.Data.Version (showbVersion) main :: IO () main = hspec spec @@ -16,10 +17,10 @@ spec :: Spec spec = parallel $ do describe "Version" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Version -> Bool) - describe "showbVersionConcrete" $ - prop "has the same output as showVersion" prop_showVersion + matchesTextShowSpec (Proxy :: Proxy Version) + describe "showbVersion" $ + prop "has the same output as showVersion" prop_showVersion -- | Verifies 'showVersion' and 'showbVersion' generate the same output. prop_showVersion :: Version -> Bool -prop_showVersion v = fromString (showVersion v) == showbVersionConcrete v +prop_showVersion v = fromString (showVersion v) == showbVersion v 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 @@ -6,7 +6,7 @@ {-| Module: Spec.Derived.DataFamiliesSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -22,12 +22,13 @@ import Test.Hspec (Spec, hspec, parallel) #if MIN_VERSION_template_haskell(2,7,0) +import Data.Proxy (Proxy(..)) + import Derived.DataFamilies (NotAllShow) -import Spec.Utils (prop_matchesTextShow1, prop_genericTextShow, prop_genericTextShow1) +import Spec.Utils (matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (describe) -import Test.Hspec.QuickCheck (prop) # if __GLASGOW_HASKELL__ >= 706 import Derived.DataFamilies (KindDistinguished) @@ -35,7 +36,7 @@ # if __GLASGOW_HASKELL__ >= 708 import Derived.DataFamilies (NullaryData) -import Spec.Utils (prop_matchesTextShow) +import Spec.Utils (matchesTextShowSpec) # endif #endif @@ -46,23 +47,31 @@ spec = parallel $ do #if MIN_VERSION_template_haskell(2,7,0) describe "NotAllShow Int Int Int Int" $ do - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> NotAllShow Int Int Int Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> NotAllShow Int Int Int Int -> Bool) - prop "generic TextShow1" (prop_genericTextShow1 :: Int -> NotAllShow Int Int Int Int -> Bool) + let p :: Proxy (NotAllShow Int Int Int Int) + p = Proxy + matchesTextShow1Spec p + genericTextShowSpec p + genericTextShow1Spec p # if __GLASGOW_HASKELL__ >= 706 describe "KindDistinguished '() Int Int" $ do - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> KindDistinguished '() Int Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> KindDistinguished '() Int Int -> Bool) - prop "generic TextShow1" (prop_genericTextShow1 :: Int -> KindDistinguished '() Int Int -> Bool) + let p :: Proxy (KindDistinguished '() Int Int) + p = Proxy + matchesTextShow1Spec p + genericTextShowSpec p + genericTextShow1Spec p describe "KindDistinguished 'True Int Int" $ do - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> KindDistinguished 'True Int Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> KindDistinguished 'True Int Int -> Bool) - prop "generic TextShow1" (prop_genericTextShow1 :: Int -> KindDistinguished 'True Int Int -> Bool) + let p :: Proxy (KindDistinguished 'True Int Int) + p = Proxy + matchesTextShow1Spec p + genericTextShowSpec p + genericTextShow1Spec p # endif # if __GLASGOW_HASKELL__ >= 708 describe "NullaryData" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> NullaryData -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> NullaryData -> Bool) + let p :: Proxy NullaryData + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p # endif #else pure () 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 @@ -2,7 +2,7 @@ {-| Module: Spec.Derived.DatatypeContextsSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -12,12 +12,10 @@ -} module Spec.Derived.DatatypeContextsSpec (main, spec) where +import Data.Proxy (Proxy(..)) import Derived.DatatypeContexts - -import Spec.Utils (prop_matchesTextShow1) - +import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec @@ -25,8 +23,8 @@ spec :: Spec spec = parallel $ do describe "TyCon Int Int Int" $ - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyCon Int Int Int -> Bool) + matchesTextShow1Spec (Proxy :: Proxy (TyCon Int Int Int)) #if MIN_VERSION_template_haskell(2,7,0) describe "TyFamily Int Int Int" $ - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyFamily Int Int Int -> Bool) + 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 @@ -2,7 +2,7 @@ {-| Module: Spec.Derived.ExistentialQuantificationSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -12,12 +12,10 @@ -} module Spec.Derived.ExistentialQuantificationSpec (main, spec) where +import Data.Proxy (Proxy(..)) import Derived.ExistentialQuantification - -import Spec.Utils (prop_matchesTextShow1) - +import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec @@ -25,8 +23,8 @@ spec :: Spec spec = parallel $ do describe "TyCon Int Int Int Int" $ - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyCon Int Int Int Int -> Bool) + matchesTextShow1Spec (Proxy :: Proxy (TyCon Int Int Int Int)) #if MIN_VERSION_template_haskell(2,7,0) describe "TyFamily Int Int Int Int" $ - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyFamily Int Int Int Int -> Bool) + 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 @@ -2,7 +2,7 @@ {-| Module: Spec.Derived.InfixSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -12,12 +12,10 @@ -} module Spec.Derived.InfixSpec (main, spec) where +import Data.Proxy (Proxy(..)) import Derived.Infix - -import Spec.Utils (prop_matchesTextShow, prop_genericTextShow, prop_genericTextShow1) - +import Spec.Utils (matchesTextShowSpec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec @@ -25,20 +23,28 @@ spec :: Spec spec = parallel $ do describe "TyConPlain Int Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> TyConPlain Int Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> TyConPlain Int Int -> Bool) - prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyConPlain Int Int -> Bool) + let p :: Proxy (TyConPlain Int Int) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p + genericTextShow1Spec p describe "TyConGADT Int Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> TyConGADT Int Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> TyConGADT Int Int -> Bool) - prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyConGADT Int Int -> Bool) + let p :: Proxy (TyConGADT Int Int) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p + genericTextShow1Spec p #if MIN_VERSION_template_haskell(2,7,0) describe "TyFamilyPlain Int Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> TyFamilyPlain Int Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> TyFamilyPlain Int Int -> Bool) - prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyFamilyPlain Int Int -> Bool) + let p :: Proxy (TyFamilyPlain Int Int) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p + genericTextShow1Spec p describe "TyFamilyGADT Int Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> TyFamilyGADT Int Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> TyFamilyGADT Int Int -> Bool) - prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyFamilyGADT Int Int -> Bool) + let p :: Proxy (TyFamilyGADT Int Int) + p = Proxy + 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 @@ -3,7 +3,7 @@ {-| Module: Spec.Derived.MagicHashSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -13,12 +13,10 @@ -} module Spec.Derived.MagicHashSpec (main, spec) where +import Data.Proxy (Proxy(..)) import Derived.MagicHash - -import Spec.Utils (prop_matchesTextShow1, prop_genericTextShow, prop_genericTextShow1) - +import Spec.Utils (matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec @@ -26,12 +24,16 @@ spec :: Spec spec = parallel $ do describe "TyCon# Int Int" $ do - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyCon# Int Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> TyCon# Int Int -> Bool) - prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyCon# Int Int -> Bool) + let p :: Proxy (TyCon# Int Int) + p = Proxy + matchesTextShow1Spec p + genericTextShowSpec p + genericTextShow1Spec p #if MIN_VERSION_template_haskell(2,7,0) describe "TyFamily# Int Int" $ do - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyFamily# Int Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> TyFamily# Int Int -> Bool) - prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyFamily# Int Int -> Bool) + 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 @@ -2,7 +2,7 @@ {-| Module: Spec.Derived.PolyKindsSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -12,12 +12,10 @@ -} module Spec.Derived.PolyKindsSpec (main, spec) where +import Data.Proxy (Proxy(..)) import Derived.PolyKinds - -import Spec.Utils (prop_matchesTextShow1, prop_genericTextShow, prop_genericTextShow1) - +import Spec.Utils (matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec @@ -25,28 +23,40 @@ spec :: Spec spec = parallel $ do describe "TyConCompose Either Either Either Maybe Maybe Int Int" $ do - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyConCompose Either Either Either Maybe Maybe Int Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> TyConCompose Either Either Either Maybe Maybe Int Int -> Bool) - prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyConCompose Either Either Either Maybe Maybe Int Int -> Bool) + let p :: Proxy (TyConCompose Either Either Either Maybe Maybe Int Int) + p = Proxy + matchesTextShow1Spec p + genericTextShowSpec p + genericTextShow1Spec p describe "TyConProxy Int Int" $ do - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyConProxy Int Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> TyConProxy Int Int -> Bool) - prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyConProxy Int Int -> Bool) + let p :: Proxy (TyConProxy Int Int) + p = Proxy + matchesTextShow1Spec p + genericTextShowSpec p + genericTextShow1Spec p describe "TyConReallyHighKinds (,,,,) Int Int Int Int Int" $ do - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyConReallyHighKinds (,,,,) Int Int Int Int Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> TyConReallyHighKinds (,,,,) Int Int Int Int Int -> Bool) - prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyConReallyHighKinds (,,,,) Int Int Int Int Int -> Bool) + let p :: Proxy (TyConReallyHighKinds (,,,,) Int Int Int Int Int) + p = Proxy + matchesTextShow1Spec p + genericTextShowSpec p + genericTextShow1Spec p #if MIN_VERSION_template_haskell(2,7,0) describe "TyFamilyCompose Either Either Either Maybe Maybe Int Int" $ do - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyFamilyCompose Either Either Either Maybe Maybe Int Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> TyFamilyCompose Either Either Either Maybe Maybe Int Int -> Bool) - prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyFamilyCompose Either Either Either Maybe Maybe Int Int -> Bool) + let p :: Proxy (TyFamilyCompose Either Either Either Maybe Maybe Int Int) + p = Proxy + matchesTextShow1Spec p + genericTextShowSpec p + genericTextShow1Spec p describe "TyFamilyProxy Int Int" $ do - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyFamilyProxy Int Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> TyFamilyProxy Int Int -> Bool) - prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyFamilyProxy Int Int -> Bool) + let p :: Proxy (TyFamilyProxy Int Int) + p = Proxy + matchesTextShow1Spec p + genericTextShowSpec p + genericTextShow1Spec p describe "TyFamilyReallyHighKinds (,,,,) Int Int Int Int Int" $ do - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyFamilyReallyHighKinds (,,,,) Int Int Int Int Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> TyFamilyReallyHighKinds (,,,,) Int Int Int Int Int -> Bool) - prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyFamilyReallyHighKinds (,,,,) Int Int Int Int Int -> Bool) + let p :: Proxy (TyFamilyReallyHighKinds (,,,,) Int Int Int Int Int) + p = Proxy + 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 @@ -2,7 +2,7 @@ {-| Module: Spec.Derived.RankNTypesSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -12,12 +12,10 @@ -} module Spec.Derived.RankNTypesSpec (main, spec) where +import Data.Proxy (Proxy(..)) import Derived.RankNTypes - -import Spec.Utils (prop_matchesTextShow1) - +import Spec.Utils (matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec @@ -25,8 +23,8 @@ spec :: Spec spec = parallel $ do describe "TyCon Int Int" $ - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyCon Int Int -> Bool) + matchesTextShow1Spec (Proxy :: Proxy (TyCon Int Int)) #if MIN_VERSION_template_haskell(2,7,0) describe "TyFamily Int Int" $ - prop "TextShow2 instance" (prop_matchesTextShow1 :: Int -> TyFamily Int Int -> Bool) + 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 @@ -2,7 +2,7 @@ {-| Module: Spec.Derived.RecordsSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -12,12 +12,10 @@ -} module Spec.Derived.RecordsSpec (main, spec) where +import Data.Proxy (Proxy(..)) import Derived.Records - -import Spec.Utils (prop_matchesTextShow1, prop_genericTextShow, prop_genericTextShow1) - +import Spec.Utils (matchesTextShow1Spec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec @@ -25,12 +23,16 @@ spec :: Spec spec = parallel $ do describe "TyCon Int Int" $ do - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyCon Int Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> TyCon Int Int -> Bool) - prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyCon Int Int -> Bool) + let p :: Proxy (TyCon Int Int) + p = Proxy + matchesTextShow1Spec p + genericTextShowSpec p + genericTextShow1Spec p #if MIN_VERSION_template_haskell(2,7,0) describe "TyFamily Int Int" $ do - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> TyFamily Int Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> TyFamily Int Int -> Bool) - prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyFamily Int Int -> Bool) + 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 @@ -2,7 +2,7 @@ {-| Module: Spec.Derived.TypeSynonymsSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -12,12 +12,10 @@ -} module Spec.Derived.TypeSynonymsSpec (main, spec) where +import Data.Proxy (Proxy(..)) import Derived.TypeSynonyms - -import Spec.Utils (prop_matchesTextShow, prop_genericTextShow, prop_genericTextShow1) - +import Spec.Utils (matchesTextShowSpec, genericTextShowSpec, genericTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec @@ -25,12 +23,16 @@ spec :: Spec spec = parallel $ do describe "TyCon Int Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> TyCon Int Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> TyCon Int Int -> Bool) - prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyCon Int Int -> Bool) + let p :: Proxy (TyCon Int Int) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p + genericTextShow1Spec p #if MIN_VERSION_template_haskell(2,7,0) describe "TyFamily Int Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> TyFamily Int Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> TyFamily Int Int -> Bool) - prop "generic TextShow1" (prop_genericTextShow1 :: Int -> TyFamily Int Int -> Bool) + 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 @@ -2,7 +2,7 @@ {-| Module: Spec.Foreign.C.TypesSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -12,14 +12,11 @@ -} module Spec.Foreign.C.TypesSpec (main, spec) where +import Data.Proxy (Proxy(..)) import Foreign.C.Types - import Instances.Foreign.C.Types () - -import Spec.Utils (prop_matchesTextShow) - +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec @@ -27,54 +24,58 @@ spec :: Spec spec = parallel $ do describe "CChar" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CChar -> Bool) + matchesTextShowSpec (Proxy :: Proxy CChar) describe "CSChar" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CSChar -> Bool) + matchesTextShowSpec (Proxy :: Proxy CSChar) describe "CUChar" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CUChar -> Bool) + matchesTextShowSpec (Proxy :: Proxy CUChar) describe "CShort" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CShort -> Bool) + matchesTextShowSpec (Proxy :: Proxy CShort) describe "CUShort" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CUShort -> Bool) + matchesTextShowSpec (Proxy :: Proxy CUShort) describe "CInt" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CInt -> Bool) + matchesTextShowSpec (Proxy :: Proxy CInt) describe "CUInt" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CUInt -> Bool) + matchesTextShowSpec (Proxy :: Proxy CUInt) describe "CLong" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CLong -> Bool) + matchesTextShowSpec (Proxy :: Proxy CLong) describe "CULong" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CULong -> Bool) + matchesTextShowSpec (Proxy :: Proxy CULong) describe "CPtrdiff" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CPtrdiff -> Bool) + matchesTextShowSpec (Proxy :: Proxy CPtrdiff) describe "CSize" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CSize -> Bool) + matchesTextShowSpec (Proxy :: Proxy CSize) describe "CWchar" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CWchar -> Bool) + matchesTextShowSpec (Proxy :: Proxy CWchar) describe "CSigAtomic" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CSigAtomic -> Bool) + matchesTextShowSpec (Proxy :: Proxy CSigAtomic) describe "CLLong" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CLLong -> Bool) + matchesTextShowSpec (Proxy :: Proxy CLLong) describe "CULLong" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CULLong -> Bool) + matchesTextShowSpec (Proxy :: Proxy CULLong) describe "CIntPtr" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CIntPtr -> Bool) + matchesTextShowSpec (Proxy :: Proxy CIntPtr) describe "CUIntPtr" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CUIntPtr -> Bool) + matchesTextShowSpec (Proxy :: Proxy CUIntPtr) describe "CIntMax" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CIntMax -> Bool) + matchesTextShowSpec (Proxy :: Proxy CIntMax) describe "CUIntMax" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CUIntMax -> Bool) + matchesTextShowSpec (Proxy :: Proxy CUIntMax) describe "CClock" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CClock -> Bool) + matchesTextShowSpec (Proxy :: Proxy CClock) describe "CTime" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CTime -> Bool) + matchesTextShowSpec (Proxy :: Proxy CTime) #if MIN_VERSION_base(4,4,0) describe "CUSeconds" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CUSeconds -> Bool) + matchesTextShowSpec (Proxy :: Proxy CUSeconds) describe "CSUSeconds" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CSUSeconds -> Bool) + matchesTextShowSpec (Proxy :: Proxy CSUSeconds) #endif describe "CFloat" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CFloat -> Bool) + matchesTextShowSpec (Proxy :: Proxy CFloat) describe "CDouble" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CDouble -> Bool) + matchesTextShowSpec (Proxy :: Proxy CDouble) +#if MIN_VERSION_base(4,10,0) + describe "CBool" $ + matchesTextShowSpec (Proxy :: Proxy CBool) +#endif diff --git a/tests/Spec/Foreign/PtrSpec.hs b/tests/Spec/Foreign/PtrSpec.hs --- a/tests/Spec/Foreign/PtrSpec.hs +++ b/tests/Spec/Foreign/PtrSpec.hs @@ -1,6 +1,6 @@ {-| Module: Spec.Foreign.PtrSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -10,6 +10,8 @@ -} module Spec.Foreign.PtrSpec (main, spec) where +import Data.Proxy (Proxy(..)) + import Foreign.ForeignPtr (newForeignPtr_) import Foreign.Ptr (FunPtr, IntPtr, Ptr, WordPtr) @@ -18,7 +20,7 @@ import Prelude () import Prelude.Compat -import Spec.Utils (prop_matchesTextShow) +import Spec.Utils (matchesTextShowSpec, prop_matchesTextShow) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop) @@ -30,13 +32,13 @@ spec :: Spec spec = parallel $ do describe "Ptr Int" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Ptr Int -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Ptr Int)) describe "FunPtr Int" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> FunPtr Int -> Bool) + matchesTextShowSpec (Proxy :: Proxy (FunPtr Int)) describe "IntPtr" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> IntPtr -> Bool) + matchesTextShowSpec (Proxy :: Proxy IntPtr) describe "WordPtr" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> WordPtr -> Bool) + matchesTextShowSpec (Proxy :: Proxy WordPtr) describe "ForeignPtr" $ prop "TextShow instance" prop_showForeignPtr diff --git a/tests/Spec/FromStringTextShowSpec.hs b/tests/Spec/FromStringTextShowSpec.hs --- a/tests/Spec/FromStringTextShowSpec.hs +++ b/tests/Spec/FromStringTextShowSpec.hs @@ -2,7 +2,7 @@ {-| Module: Spec.FromStringTextShowSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -12,17 +12,14 @@ -} module Spec.FromStringTextShowSpec (main, spec) where +import Data.Proxy (Proxy(..)) import Instances.FromStringTextShow () - -import Spec.Utils (prop_matchesTextShow, prop_matchesTextShow1) - +import Spec.Utils (matchesTextShowSpec, matchesTextShow1Spec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) - import TextShow (FromStringShow(..), FromTextShow(..)) #if defined(NEW_FUNCTOR_CLASSES) -import Spec.Utils (prop_matchesTextShow2) +import Spec.Utils (matchesTextShow2Spec) import TextShow (FromStringShow1(..), FromStringShow2(..), FromTextShow1(..), FromTextShow2(..)) #endif @@ -33,30 +30,46 @@ spec :: Spec spec = parallel $ do describe "FromStringShow Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> FromStringShow Int -> Bool) - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> FromStringShow Int -> Bool) + let p :: Proxy (FromStringShow Int) + p = Proxy + matchesTextShowSpec p + matchesTextShow1Spec p describe "FromStringShow String" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> FromStringShow String -> Bool) - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> FromStringShow String -> Bool) + let p :: Proxy (FromStringShow String) + p = Proxy + matchesTextShowSpec p + matchesTextShow1Spec p describe "FromTextShow Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> FromTextShow Int -> Bool) - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> FromTextShow Int -> Bool) + let p :: Proxy (FromTextShow Int) + p = Proxy + matchesTextShowSpec p + matchesTextShow1Spec p describe "FromTextShow String" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> FromTextShow String -> Bool) - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> FromTextShow String -> Bool) + let p :: Proxy (FromTextShow String) + p = Proxy + matchesTextShowSpec p + matchesTextShow1Spec p #if defined(NEW_FUNCTOR_CLASSES) describe "FromStringShow1 Maybe Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> FromStringShow1 Maybe Int -> Bool) - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> FromStringShow1 Maybe Int -> Bool) + let p :: Proxy (FromStringShow1 Maybe Int) + p = Proxy + matchesTextShowSpec p + matchesTextShow1Spec p describe "FromTextShow1 Maybe Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> FromTextShow1 Maybe Int -> Bool) - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> FromTextShow1 Maybe Int -> Bool) + let p :: Proxy (FromTextShow1 Maybe Int) + p = Proxy + matchesTextShowSpec p + matchesTextShow1Spec p describe "FromStringShow2 Either Char Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> FromStringShow2 Either Char Int -> Bool) - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> FromStringShow2 Either Char Int -> Bool) - prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> FromStringShow2 Either Char Int -> Bool) + let p :: Proxy (FromStringShow2 Either Char Int) + p = Proxy + matchesTextShowSpec p + matchesTextShow1Spec p + matchesTextShow2Spec p describe "FromTextShow2 Either Char Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> FromTextShow2 Either Char Int -> Bool) - prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> FromTextShow2 Either Char Int -> Bool) - prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> FromTextShow2 Either Char Int -> Bool) + let p :: Proxy (FromTextShow2 Either Char Int) + p = Proxy + matchesTextShowSpec p + matchesTextShow1Spec p + matchesTextShow2Spec p #endif diff --git a/tests/Spec/FunctionsSpec.hs b/tests/Spec/FunctionsSpec.hs --- a/tests/Spec/FunctionsSpec.hs +++ b/tests/Spec/FunctionsSpec.hs @@ -1,6 +1,6 @@ {-| Module: Spec.FunctionsSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -10,11 +10,9 @@ -} module Spec.FunctionsSpec (main, spec) where -import Spec.Utils (prop_matchesTextShow) - +import Data.Proxy (Proxy(..)) +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) - import Text.Show.Functions () import TextShow.Functions () @@ -23,4 +21,4 @@ spec :: Spec spec = parallel . describe "Int -> Int" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> (Int -> Int) -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Int -> Int)) diff --git a/tests/Spec/GHC/Conc/WindowsSpec.hs b/tests/Spec/GHC/Conc/WindowsSpec.hs --- a/tests/Spec/GHC/Conc/WindowsSpec.hs +++ b/tests/Spec/GHC/Conc/WindowsSpec.hs @@ -2,7 +2,7 @@ {-| Module: Spec.GHC.Conc.WindowsSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -20,12 +20,10 @@ import Test.Hspec (Spec, hspec, parallel) #if !defined(__GHCJS__) && defined(mingw32_HOST_OS) +import Data.Proxy (Proxy(..)) import GHC.Conc.Windows (ConsoleEvent) - -import Spec.Utils (prop_matchesTextShow) - +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe) -import Test.Hspec.QuickCheck (prop) #endif main :: IO () @@ -35,7 +33,7 @@ spec = parallel $ #if !defined(__GHCJS__) && defined(mingw32_HOST_OS) describe "ConsoleEvent" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> ConsoleEvent -> Bool) + matchesTextShowSpec (Proxy :: Proxy ConsoleEvent) #else pure () #endif 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 @@ -2,7 +2,7 @@ {-| Module: Spec.GHC.EventSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -20,15 +20,16 @@ import Test.Hspec (Spec, hspec, parallel) #if !defined(__GHCJS__) && !defined(mingw32_HOST_OS) && MIN_VERSION_base(4,4,0) +import Data.Proxy (Proxy(..)) + import GHC.Event (Event) # if MIN_VERSION_base(4,8,1) import GHC.Event (Lifetime) #endif -import Spec.Utils (prop_matchesTextShow) +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe) -import Test.Hspec.QuickCheck (prop) #endif @@ -39,12 +40,12 @@ spec = parallel $ do #if !defined(__GHCJS__) && !defined(mingw32_HOST_OS) && MIN_VERSION_base(4,4,0) describe "Event" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Event -> Bool) + matchesTextShowSpec (Proxy :: Proxy Event) -- describe "FdKey" $ --- prop "TextShow instance" (prop_matchesTextShow :: Int -> FdKey -> Bool) +-- matchesTextShowSpec (Proxy :: Proxy FdKey) # if MIN_VERSION_base(4,8,1) describe "Lifetime" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Lifetime -> Bool) + matchesTextShowSpec (Proxy :: Proxy Lifetime) # endif #else pure () 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 @@ -2,7 +2,7 @@ {-| Module: Spec.GHC.FingerprintSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -22,12 +22,10 @@ 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 (prop_matchesTextShow) - +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe) -import Test.Hspec.QuickCheck (prop) #endif main :: IO () @@ -37,7 +35,7 @@ spec = parallel $ #if MIN_VERSION_base(4,4,0) describe "Fingerprint" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Fingerprint -> Bool) + matchesTextShowSpec (Proxy :: Proxy Fingerprint) #else pure () #endif diff --git a/tests/Spec/GHC/GenericsSpec.hs b/tests/Spec/GHC/GenericsSpec.hs --- a/tests/Spec/GHC/GenericsSpec.hs +++ b/tests/Spec/GHC/GenericsSpec.hs @@ -7,7 +7,7 @@ {-| Module: Spec.GHC.GenericsSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -18,6 +18,7 @@ module Spec.GHC.GenericsSpec (main, spec) where import Data.Orphans () +import Data.Proxy (Proxy(..)) import Generics.Deriving.Base ( U1, Par1, Rec1, K1, M1, (:+:), (:*:), (:.:) , UChar, UDouble, UFloat, UInt, UWord @@ -32,10 +33,9 @@ import Instances.GHC.Generics () -import Spec.Utils (prop_matchesTextShow, prop_genericTextShow) +import Spec.Utils (matchesTextShowSpec, genericTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec @@ -55,62 +55,100 @@ spec :: Spec spec = parallel $ do describe "Fixity" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> Fixity -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> Fixity -> Bool) + let p :: Proxy Fixity + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p describe "Associativity" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> Associativity -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> Associativity -> Bool) + let p :: Proxy Associativity + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p #if MIN_VERSION_base(4,9,0) describe "SourceUnpackedness" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> SourceUnpackedness -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> SourceUnpackedness -> Bool) + let p :: Proxy SourceUnpackedness + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p describe "SourceStrictness" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> SourceStrictness -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> SourceStrictness -> Bool) + let p :: Proxy SourceStrictness + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p describe "DecidedStrictness" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> DecidedStrictness -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> DecidedStrictness -> Bool) + let p :: Proxy DecidedStrictness + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p #else describe "Arity" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> Arity -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> Arity -> Bool) + let p :: Proxy Arity + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p #endif describe "U1 Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> U1 Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> U1 Int -> Bool) + let p :: Proxy (U1 Int) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p describe "Par1 Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> Par1 Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> Par1 Int -> Bool) + let p :: Proxy (Par1 Int) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p describe "Rec1 Maybe Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> Rec1 Maybe Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> Rec1 Maybe Int -> Bool) + let p :: Proxy (Rec1 Maybe Int) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p describe "K1 () Int ()" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> K1 () Int () -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> K1 () Int () -> Bool) + let p :: Proxy (K1 () Int ()) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p describe m1Description $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> M1 () MD Maybe Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> M1 () MD Maybe Int -> Bool) + let p :: Proxy (M1 () MD Maybe Int) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p describe "(Maybe :+: Maybe) Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> (Maybe :+: Maybe) Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> (Maybe :+: Maybe) Int -> Bool) + let p :: Proxy ((Maybe :+: Maybe) Int) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p describe "(Maybe :*: Maybe) Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> (Maybe :*: Maybe) Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> (Maybe :*: Maybe) Int -> Bool) + let p :: Proxy ((Maybe :*: Maybe) Int) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p describe "(Maybe :.: Maybe) Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> (Maybe :.: Maybe) Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> (Maybe :.: Maybe) Int -> Bool) + let p :: Proxy ((Maybe :.: Maybe) Int) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p describe "UChar Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> UChar Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> UChar Int -> Bool) + let p :: Proxy (UChar Int) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p describe "UDouble Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> UDouble Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> UDouble Int -> Bool) + let p :: Proxy (UDouble Int) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p describe "UFloat Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> UFloat Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> UFloat Int -> Bool) + let p :: Proxy (UFloat Int) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p describe "UInt Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> UInt Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> UInt Int -> Bool) + let p :: Proxy (UInt Int) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p describe "UWord Int" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> UWord Int -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> UWord Int -> Bool) + let p :: Proxy (UWord Int) + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p diff --git a/tests/Spec/GHC/RTS/FlagsSpec.hs b/tests/Spec/GHC/RTS/FlagsSpec.hs --- a/tests/Spec/GHC/RTS/FlagsSpec.hs +++ b/tests/Spec/GHC/RTS/FlagsSpec.hs @@ -2,7 +2,7 @@ {-| Module: Spec.GHC.RTS.Flags -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -12,21 +12,17 @@ -} module Spec.GHC.RTS.FlagsSpec (main, spec) where -import Instances.GHC.RTS.Flags () - import Prelude () import Prelude.Compat import Test.Hspec (Spec, hspec, parallel) #if MIN_VERSION_base(4,8,0) +import Data.Proxy (Proxy(..)) import GHC.RTS.Flags - -import Spec.Utils (prop_matchesTextShow) - +import Instances.GHC.RTS.Flags +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe) -import Test.Hspec.QuickCheck (prop) -import Test.QuickCheck (Property, ioProperty) #endif main :: IO () @@ -36,59 +32,35 @@ spec = parallel $ do #if MIN_VERSION_base(4,8,0) describe "RTSFlags" $ - prop "TextShow instance" prop_showRTSFlags + matchesTextShowSpec (Proxy :: Proxy RTSFlags) describe "GCFlags" $ - prop "TextShow instance" prop_showGCFlags + matchesTextShowSpec (Proxy :: Proxy GCFlags) describe "ConcFlags" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> ConcFlags -> Bool) + matchesTextShowSpec (Proxy :: Proxy ConcFlags) describe "MiscFlags" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> MiscFlags -> Bool) + matchesTextShowSpec (Proxy :: Proxy MiscFlags) describe "DebugFlags" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> DebugFlags -> Bool) + matchesTextShowSpec (Proxy :: Proxy DebugFlags) describe "CCFlags" $ - prop "TextShow instance" prop_showCCFlags + matchesTextShowSpec (Proxy :: Proxy CCFlags) describe "ProfFlags" $ - prop "TextShow instance" prop_showProfFlags + matchesTextShowSpec (Proxy :: Proxy ProfFlags) describe "TraceFlags" $ - prop "TextShow instance" prop_showTraceFlags + matchesTextShowSpec (Proxy :: Proxy TraceFlags) describe "TickyFlags" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> TickyFlags -> Bool) -# if __GLASGOW_HASKELL__ >= 801 + matchesTextShowSpec (Proxy :: Proxy TickyFlags) + describe "GiveGCStats" $ + matchesTextShowSpec (Proxy :: Proxy GiveGCStats') + describe "DoCostCentres" $ + matchesTextShowSpec (Proxy :: Proxy DoCostCentres') + describe "DoHeapProfile" $ + matchesTextShowSpec (Proxy :: Proxy DoHeapProfile') + describe "DoTrace" $ + matchesTextShowSpec (Proxy :: Proxy DoTrace') +# if MIN_VERSION_base(4,10,0) describe "ParFlags" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> ParFlags -> Bool) + matchesTextShowSpec (Proxy :: Proxy ParFlags) # endif #else pure () -#endif - -#if MIN_VERSION_base(4,8,0) --- | Verifies that the 'Show' instance for 'RTSFlags' is accurate. -prop_showRTSFlags :: Int -> Property -prop_showRTSFlags p = ioProperty $ do - rtsflags <- getRTSFlags - pure $ prop_matchesTextShow p rtsflags - --- | Verifies that the 'Show' instance for 'GCFlags' is accurate. -prop_showGCFlags :: Int -> Property -prop_showGCFlags p = ioProperty $ do - gcflags <- getGCFlags - pure $ prop_matchesTextShow p gcflags - --- | Verifies that the 'Show' instance for 'CCFlags' is accurate. -prop_showCCFlags :: Int -> Property -prop_showCCFlags p = ioProperty $ do - ccflags <- getCCFlags - pure $ prop_matchesTextShow p ccflags - --- | Verifies that the 'Show' instance for 'ProfFlags' is accurate. -prop_showProfFlags :: Int -> Property -prop_showProfFlags p = ioProperty $ do - profflags <- getProfFlags - pure $ prop_matchesTextShow p profflags - --- | Verifies that the 'Show' instance for 'TraceFlags' is accurate. -prop_showTraceFlags :: Int -> Property -prop_showTraceFlags p = ioProperty $ do - traceflags <- getTraceFlags - pure $ prop_matchesTextShow p traceflags #endif diff --git a/tests/Spec/GHC/StackSpec.hs b/tests/Spec/GHC/StackSpec.hs --- a/tests/Spec/GHC/StackSpec.hs +++ b/tests/Spec/GHC/StackSpec.hs @@ -2,7 +2,7 @@ {-| Module: Spec.GHC.StackSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -19,13 +19,18 @@ import Test.Hspec (Spec, hspec, parallel) -#if MIN_VERSION_base(4,9,0) -import GHC.Stack (CallStack, SrcLoc) +#if MIN_VERSION_base(4,8,1) +import Data.Proxy (Proxy(..)) +import GHC.Stack (CallStack) +# if MIN_VERSION_base(4,9,0) +import GHC.Stack (SrcLoc) +# else +import GHC.SrcLoc (SrcLoc) +# endif -import Spec.Utils (prop_matchesTextShow) +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe) -import Test.Hspec.QuickCheck (prop) #endif main :: IO () @@ -33,11 +38,11 @@ spec :: Spec spec = parallel $ do -#if MIN_VERSION_base(4,9,0) +#if MIN_VERSION_base(4,8,1) describe "CallStack" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CallStack -> Bool) + matchesTextShowSpec (Proxy :: Proxy CallStack) describe "SrcLoc" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> SrcLoc -> Bool) + matchesTextShowSpec (Proxy :: Proxy SrcLoc) #else pure () #endif diff --git a/tests/Spec/GHC/StaticPtrSpec.hs b/tests/Spec/GHC/StaticPtrSpec.hs --- a/tests/Spec/GHC/StaticPtrSpec.hs +++ b/tests/Spec/GHC/StaticPtrSpec.hs @@ -2,7 +2,7 @@ {-| Module: Spec.GHC.StaticPtrSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -20,12 +20,10 @@ import Test.Hspec (Spec, hspec, parallel) #if MIN_VERSION_base(4,8,0) +import Data.Proxy (Proxy(..)) import GHC.StaticPtr (StaticPtrInfo) - -import Spec.Utils (prop_matchesTextShow) - +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe) -import Test.Hspec.QuickCheck (prop) #endif main :: IO () @@ -35,7 +33,7 @@ spec = parallel $ #if MIN_VERSION_base(4,8,0) describe "StaticPtrInfo" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> StaticPtrInfo -> Bool) + matchesTextShowSpec (Proxy :: Proxy StaticPtrInfo) #else pure () #endif diff --git a/tests/Spec/GHC/StatsSpec.hs b/tests/Spec/GHC/StatsSpec.hs --- a/tests/Spec/GHC/StatsSpec.hs +++ b/tests/Spec/GHC/StatsSpec.hs @@ -1,8 +1,9 @@ {-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-deprecations #-} {-| Module: Spec.GHC.StatsSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -20,12 +21,10 @@ import Test.Hspec (Spec, hspec, parallel) #if MIN_VERSION_base(4,5,0) +import Data.Proxy (Proxy(..)) import GHC.Stats (GCStats) - -import Spec.Utils (prop_matchesTextShow) - +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe) -import Test.Hspec.QuickCheck (prop) #endif main :: IO () @@ -35,7 +34,7 @@ spec = parallel $ #if MIN_VERSION_base(4,5,0) describe "GCStats" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> GCStats -> Bool) + matchesTextShowSpec (Proxy :: Proxy GCStats) #else pure () #endif diff --git a/tests/Spec/GHC/TypeLitsSpec.hs b/tests/Spec/GHC/TypeLitsSpec.hs --- a/tests/Spec/GHC/TypeLitsSpec.hs +++ b/tests/Spec/GHC/TypeLitsSpec.hs @@ -6,7 +6,7 @@ {-| Module: Spec.GHC.TypeLitsSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -24,12 +24,10 @@ import Test.Hspec (Spec, hspec, parallel) #if MIN_VERSION_base(4,6,0) +import Data.Proxy (Proxy(..)) import GHC.TypeLits - -import Spec.Utils (prop_matchesTextShow) - +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (describe) -import Test.Hspec.QuickCheck (prop) #endif main :: IO () @@ -39,24 +37,24 @@ spec = parallel $ do #if MIN_VERSION_base(4,7,0) describe "SomeNat" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> SomeNat -> Bool) + matchesTextShowSpec (Proxy :: Proxy SomeNat) describe "SomeSymbol" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> SomeSymbol -> Bool) + matchesTextShowSpec (Proxy :: Proxy SomeSymbol) #elif MIN_VERSION_base(4,6,0) describe "IsEven 0" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> IsEven 0 -> Bool) + matchesTextShowSpec (Proxy :: Proxy (IsEven 0)) describe "IsEven 1" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> IsEven 1 -> Bool) + matchesTextShowSpec (Proxy :: Proxy (IsEven 1)) describe "IsEven 2" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> IsEven 2 -> Bool) + matchesTextShowSpec (Proxy :: Proxy (IsEven 2)) describe "IsZero 0" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> IsZero 0 -> Bool) + matchesTextShowSpec (Proxy :: Proxy (IsZero 0)) describe "IsZero 1" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> IsZero 1 -> Bool) + matchesTextShowSpec (Proxy :: Proxy (IsZero 1)) describe "Sing 0" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Sing 0 -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Sing 0)) describe "Sing \"a\"" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Sing "a" -> Bool) + matchesTextShowSpec (Proxy :: Proxy (Sing "a")) #else pure () #endif diff --git a/tests/Spec/GenericSpec.hs b/tests/Spec/GenericSpec.hs --- a/tests/Spec/GenericSpec.hs +++ b/tests/Spec/GenericSpec.hs @@ -1,6 +1,6 @@ {-| Module: Spec.GenericSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -10,13 +10,10 @@ -} module Spec.GenericSpec (main, spec) where +import Data.Proxy (Proxy(..)) import Instances.Generic () - -import Spec.Utils (prop_matchesTextShow, prop_genericTextShow) - +import Spec.Utils (matchesTextShowSpec, genericTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) - import TextShow.Generic (ConType) main :: IO () @@ -24,5 +21,7 @@ spec :: Spec spec = parallel . describe "ConType" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> ConType -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> ConType -> Bool) + let p :: Proxy ConType + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p 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 @@ -1,6 +1,6 @@ {-| Module: Spec.Numeric.NaturalSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -10,16 +10,14 @@ -} module Spec.Numeric.NaturalSpec (main, spec) where +import Data.Proxy (Proxy(..)) import Numeric.Natural (Natural) - -import Spec.Utils (prop_matchesTextShow) - +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "Natural" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Natural -> Bool) + matchesTextShowSpec (Proxy :: Proxy Natural) diff --git a/tests/Spec/OptionsSpec.hs b/tests/Spec/OptionsSpec.hs --- a/tests/Spec/OptionsSpec.hs +++ b/tests/Spec/OptionsSpec.hs @@ -1,6 +1,6 @@ {-| Module: Spec.OptionsSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -10,13 +10,10 @@ -} module Spec.OptionsSpec (main, spec) where +import Data.Proxy (Proxy(..)) import Instances.Options () - -import Spec.Utils (prop_matchesTextShow, prop_genericTextShow) - +import Spec.Utils (matchesTextShowSpec, genericTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) - import TextShow.TH (Options, GenTextMethods) main :: IO () @@ -25,8 +22,12 @@ spec :: Spec spec = parallel $ do describe "Options" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> Options -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> Options -> Bool) + let p :: Proxy Options + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p describe "GenTextMethods" $ do - prop "TextShow instance" (prop_matchesTextShow :: Int -> GenTextMethods -> Bool) - prop "generic TextShow" (prop_genericTextShow :: Int -> GenTextMethods -> Bool) + let p :: Proxy GenTextMethods + p = Proxy + matchesTextShowSpec p + genericTextShowSpec p 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 @@ -1,6 +1,6 @@ {-| Module: Spec.System.ExitSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -10,18 +10,15 @@ -} module Spec.System.ExitSpec (main, spec) where +import Data.Proxy (Proxy(..)) import Instances.System.Exit () - -import Spec.Utils (prop_matchesTextShow) - +import Spec.Utils (matchesTextShowSpec) import System.Exit (ExitCode) - import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) main :: IO () main = hspec spec spec :: Spec spec = parallel . describe "ExitCode" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> ExitCode -> Bool) + matchesTextShowSpec (Proxy :: Proxy ExitCode) 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 @@ -2,7 +2,7 @@ {-| Module: Spec.System.IOSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -12,6 +12,8 @@ -} module Spec.System.IOSpec (main, spec) where +import Data.Proxy (Proxy(..)) + #if MIN_VERSION_base(4,4,0) import GHC.IO.Encoding.Failure (CodingFailureMode) import GHC.IO.Encoding.Types (CodingProgress) @@ -22,7 +24,7 @@ import Prelude () import Prelude.Compat -import Spec.Utils (prop_matchesTextShow) +import Spec.Utils (matchesTextShowSpec, prop_matchesTextShow) import System.IO (BufferMode, IOMode, HandlePosn, Newline, NewlineMode, SeekMode, Handle, mkTextEncoding) @@ -37,27 +39,27 @@ spec :: Spec spec = parallel $ do describe "Handle" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Handle -> Bool) + matchesTextShowSpec (Proxy :: Proxy Handle) describe "IOMode" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> IOMode -> Bool) + matchesTextShowSpec (Proxy :: Proxy IOMode) describe "BufferMode" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> BufferMode -> Bool) + matchesTextShowSpec (Proxy :: Proxy BufferMode) describe "HandlePosn" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> HandlePosn -> Bool) + matchesTextShowSpec (Proxy :: Proxy HandlePosn) describe "SeekMode" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> SeekMode -> Bool) + matchesTextShowSpec (Proxy :: Proxy SeekMode) describe "TextEncoding" $ prop "TextShow instance" prop_showTextEncoding #if MIN_VERSION_base(4,4,0) describe "CodingProgress" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CodingProgress -> Bool) + matchesTextShowSpec (Proxy :: Proxy CodingProgress) describe "CodingFailureMode" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CodingFailureMode -> Bool) + matchesTextShowSpec (Proxy :: Proxy CodingFailureMode) #endif describe "Newline" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Newline -> Bool) + matchesTextShowSpec (Proxy :: Proxy Newline) describe "NewlineMode" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> NewlineMode -> Bool) + matchesTextShowSpec (Proxy :: Proxy NewlineMode) -- | Verifies the 'TextShow' instance for 'TextEncoding' is accurate. prop_showTextEncoding :: Int -> Property diff --git a/tests/Spec/System/Posix/TypesSpec.hs b/tests/Spec/System/Posix/TypesSpec.hs --- a/tests/Spec/System/Posix/TypesSpec.hs +++ b/tests/Spec/System/Posix/TypesSpec.hs @@ -2,7 +2,7 @@ {-| Module: Spec.System.Posix.TypesSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -12,14 +12,11 @@ -} module Spec.System.Posix.TypesSpec (main, spec) where +import Data.Proxy (Proxy(..)) import Instances.System.Posix.Types () - -import Spec.Utils (prop_matchesTextShow) - +import Spec.Utils (matchesTextShowSpec) import System.Posix.Types - import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) #include "HsBaseConfig.h" @@ -29,56 +26,91 @@ spec :: Spec spec = parallel $ do describe "Fd" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Fd -> Bool) + matchesTextShowSpec (Proxy :: Proxy Fd) #if defined(HTYPE_DEV_T) describe "CDev" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CDev -> Bool) + matchesTextShowSpec (Proxy :: Proxy CDev) #endif #if defined(HTYPE_INO_T) describe "CIno" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CIno -> Bool) + matchesTextShowSpec (Proxy :: Proxy CIno) #endif #if defined(HTYPE_MODE_T) describe "CMode" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CMode -> Bool) + matchesTextShowSpec (Proxy :: Proxy CMode) #endif #if defined(HTYPE_OFF_T) describe "COff" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> COff -> Bool) + matchesTextShowSpec (Proxy :: Proxy COff) #endif #if defined(HTYPE_PID_T) describe "CPid" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CPid -> Bool) + matchesTextShowSpec (Proxy :: Proxy CPid) #endif #if defined(HTYPE_SSIZE_T) describe "CSsize" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CSsize -> Bool) + matchesTextShowSpec (Proxy :: Proxy CSsize) #endif #if defined(HTYPE_GID_T) describe "CGid" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CGid -> Bool) + matchesTextShowSpec (Proxy :: Proxy CGid) #endif #if defined(HTYPE_NLINK_T) describe "CNlink" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CNlink -> Bool) + matchesTextShowSpec (Proxy :: Proxy CNlink) #endif #if defined(HTYPE_UID_T) describe "CUid" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CUid -> Bool) + matchesTextShowSpec (Proxy :: Proxy CUid) #endif #if defined(HTYPE_CC_T) describe "CCc" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CCc -> Bool) + matchesTextShowSpec (Proxy :: Proxy CCc) #endif #if defined(HTYPE_SPEED_T) describe "CSpeed" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CSpeed -> Bool) + matchesTextShowSpec (Proxy :: Proxy CSpeed) #endif #if defined(HTYPE_TCFLAG_T) describe "CTcflag" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CTcflag -> Bool) + matchesTextShowSpec (Proxy :: Proxy CTcflag) #endif #if defined(HTYPE_RLIM_T) describe "CRLim" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> CRLim -> Bool) + matchesTextShowSpec (Proxy :: Proxy CRLim) +#endif + +#if MIN_VERSION_base(4,10,0) +# if defined(HTYPE_BLKSIZE_T) + describe "CBlkSize" $ + matchesTextShowSpec (Proxy :: Proxy CBlkSize) +# endif +# if defined(HTYPE_BLKCNT_T) + describe "CBlkCnt" $ + matchesTextShowSpec (Proxy :: Proxy CBlkCnt) +# endif +# if defined(HTYPE_CLOCKID_T) + describe "CClockId" $ + matchesTextShowSpec (Proxy :: Proxy CClockId) +# endif +# if defined(HTYPE_FSBLKCNT_T) + describe "CFsBlkCnt" $ + matchesTextShowSpec (Proxy :: Proxy CFsBlkCnt) +# endif +# if defined(HTYPE_FSFILCNT_T) + describe "CFsFilCnt" $ + matchesTextShowSpec (Proxy :: Proxy CFsFilCnt) +# endif +# if defined(HTYPE_ID_T) + describe "CId" $ + matchesTextShowSpec (Proxy :: Proxy CId) +# endif +# if defined(HTYPE_KEY_T) + describe "CKey" $ + matchesTextShowSpec (Proxy :: Proxy CKey) +# endif +# if defined(HTYPE_TIMER_T) + describe "CTimer" $ + matchesTextShowSpec (Proxy :: Proxy CTimer) +# endif #endif diff --git a/tests/Spec/Text/ReadSpec.hs b/tests/Spec/Text/ReadSpec.hs --- a/tests/Spec/Text/ReadSpec.hs +++ b/tests/Spec/Text/ReadSpec.hs @@ -1,8 +1,9 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskell #-} {-| Module: Spec.Text.ReadSpec -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -12,16 +13,15 @@ -} module Spec.Text.ReadSpec (main, spec) where +import Data.Proxy (Proxy(..)) import Instances.Text.Read () - -import Spec.Utils (prop_matchesTextShow) - +import Spec.Utils (matchesTextShowSpec) import Test.Hspec (Spec, describe, hspec, parallel) -import Test.Hspec.QuickCheck (prop) - import Text.Read (Lexeme) -#if MIN_VERSION_base(4,7,0) -import Text.Read.Lex (Number) + +#if MIN_VERSION_base(4,6,0) +import Language.Haskell.TH.Lib (conT) +import TextShow.TH.Names (numberTypeName) #endif main :: IO () @@ -30,8 +30,8 @@ spec :: Spec spec = parallel $ do describe "Lexeme" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Lexeme -> Bool) -#if MIN_VERSION_base(4,7,0) + matchesTextShowSpec (Proxy :: Proxy Lexeme) +#if MIN_VERSION_base(4,6,0) describe "Number" $ - prop "TextShow instance" (prop_matchesTextShow :: Int -> Number -> Bool) + matchesTextShowSpec (Proxy :: Proxy $(conT numberTypeName)) #endif diff --git a/tests/Spec/Utils.hs b/tests/Spec/Utils.hs --- a/tests/Spec/Utils.hs +++ b/tests/Spec/Utils.hs @@ -1,9 +1,10 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} {-| Module: Spec.Utils -Copyright: (C) 2014-2016 Ryan Scott +Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott Stability: Provisional @@ -12,38 +13,65 @@ Testing-related utility functions. -} module Spec.Utils ( - prop_matchesTextShow - , prop_matchesTextShow1 + matchesTextShowSpec + , prop_matchesTextShow + , matchesTextShow1Spec #if defined(NEW_FUNCTOR_CLASSES) - , prop_matchesTextShow2 + , matchesTextShow2Spec #endif - , prop_genericTextShow - , prop_genericTextShow1 + , genericTextShowSpec + , genericTextShow1Spec ) where -import Data.Functor.Classes (Show1, showsPrec1) +import Data.Functor.Classes (Show1, showsPrec1) +import Data.Proxy (Proxy(..)) -import Generics.Deriving.Base +import Generics.Deriving.Base -import TextShow (TextShow(..), TextShow1(..), showbPrec1, fromString) -import TextShow.Generic +import Test.Hspec (Spec) +import Test.Hspec.QuickCheck (prop) +import Test.QuickCheck (Arbitrary) +import TextShow (TextShow(..), TextShow1(..), showbPrec1, fromString) +import TextShow.Generic + #if defined(NEW_FUNCTOR_CLASSES) -import Data.Functor.Classes (Show2, showsPrec2) -import TextShow (TextShow2(..), showbPrec2) +import Data.Functor.Classes (Show2, showsPrec2) +import TextShow (TextShow2(..), showbPrec2) #endif +-- | Expect a type's 'Show' instances to coincide for both 'String's and 'Text', +-- irrespective of precedence. +matchesTextShowSpec :: forall a. (Arbitrary a, Show a, TextShow a) + => Proxy a -> Spec +matchesTextShowSpec _ = prop "TextShow instance" (prop_matchesTextShow :: Int -> a -> Bool) + -- | Verifies that a type's 'Show' instances coincide for both 'String's and 'Text', -- irrespective of precedence. prop_matchesTextShow :: (Show a, TextShow a) => Int -> a -> Bool prop_matchesTextShow p x = fromString (showsPrec p x "") == showbPrec p x +-- | Expect a type's 'Show1' instances to coincide for both 'String's and 'Text', +-- irrespective of precedence. +matchesTextShow1Spec :: forall f a. + (Arbitrary (f a), Show1 f, Show a, Show (f a), TextShow1 f, TextShow a) + => Proxy (f a) -> Spec +matchesTextShow1Spec _ = prop "TextShow1 instance" (prop_matchesTextShow1 :: Int -> f a -> Bool) + -- | Verifies that a type's 'Show1' instances coincide for both 'String's and 'Text', -- irrespective of precedence. prop_matchesTextShow1 :: (Show1 f, Show a, TextShow1 f, TextShow a) => Int -> f a -> Bool prop_matchesTextShow1 p x = fromString (showsPrec1 p x "") == showbPrec1 p x #if defined(NEW_FUNCTOR_CLASSES) +-- | Expect a type's 'Show2' instances to coincide for both 'String's and 'Text', +-- irrespective of precedence. +matchesTextShow2Spec :: forall f a b. + (Arbitrary (f a b), Show2 f, Show a, Show b, Show (f a b), + TextShow2 f, TextShow a, TextShow b) + => Proxy (f a b) -> Spec +matchesTextShow2Spec _ = prop "TextShow2 instance" (prop_matchesTextShow2 :: Int -> f a b -> Bool) + -- | Verifies that a type's 'Show2' instances coincide for both 'String's and 'Text', -- irrespective of precedence. prop_matchesTextShow2 :: (Show2 f, Show a, Show b, TextShow2 f, TextShow a, TextShow b) @@ -51,11 +79,25 @@ prop_matchesTextShow2 p x = fromString (showsPrec2 p x "") == showbPrec2 p x #endif +-- | Expect a type's 'TextShow' instance to coincide with the output produced +-- by the equivalent 'Generic' functions. +genericTextShowSpec :: forall a. (Arbitrary a, Show a, TextShow a, + Generic a, GTextShowB Zero (Rep a)) + => Proxy a -> Spec +genericTextShowSpec _ = prop "generic TextShow" (prop_genericTextShow :: Int -> a -> Bool) + -- | Verifies that a type's 'TextShow' instance coincides with the output produced -- by the equivalent 'Generic' functions. prop_genericTextShow :: (TextShow a, Generic a, GTextShowB Zero (Rep a)) => Int -> a -> Bool prop_genericTextShow p x = showbPrec p x == genericShowbPrec p x + +-- | Expect a type's 'TextShow1' instance to coincide with the output produced +-- by the equivalent 'Generic1' functions. +genericTextShow1Spec :: forall f a. (Arbitrary (f a), Show (f a), TextShow1 f, + Generic1 f, GTextShowB One (Rep1 f), TextShow a) + => Proxy (f a) -> Spec +genericTextShow1Spec _ = prop "generic TextShow1" (prop_genericTextShow1 :: Int -> f a -> Bool) -- | Verifies that a type's 'TextShow1' instance coincides with the output produced -- by the equivalent 'Generic1' functions. 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.4.1.1 +version: 3.6 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 @@ -41,7 +41,7 @@ author: Ryan Scott maintainer: Ryan Scott stability: Provisional -copyright: (C) 2014-2016 Ryan Scott +copyright: (C) 2014-2017 Ryan Scott category: Text build-type: Simple tested-with: GHC == 7.0.4 @@ -50,7 +50,7 @@ , GHC == 7.6.3 , GHC == 7.8.4 , GHC == 7.10.3 - , GHC == 8.0.1 + , GHC == 8.0.2 extra-source-files: CHANGELOG.md, README.md, include/*.h cabal-version: >=1.10 @@ -185,8 +185,8 @@ build-depends: base >= 4.3 && < 4.9 if flag(template-haskell-2-11) - build-depends: template-haskell >= 2.11 && < 2.12 - , ghc-boot-th + build-depends: template-haskell >= 2.11 && < 2.13 + , ghc-boot-th >= 8.0 && < 8.3 else build-depends: template-haskell >= 2.5 && < 2.11 @@ -197,12 +197,10 @@ else build-depends: transformers == 0.4.* - hs-source-dirs: src + hs-source-dirs: src, shared default-language: Haskell2010 ghc-options: -Wall include-dirs: include - includes: inline.h - , utils.h test-suite spec type: exitcode-stdio-1.0 @@ -228,7 +226,6 @@ Instances.Data.Functor.Compose Instances.Data.Functor.Product Instances.Data.Functor.Sum - Instances.Data.List.NonEmpty Instances.Data.Ord Instances.Data.Proxy Instances.Data.Semigroup @@ -246,6 +243,7 @@ Instances.System.Posix.Types Instances.Text.Read Instances.Utils + Instances.Utils.GenericArbitrary -- Only exports instances if using Windows Instances.GHC.Conc.Windows @@ -359,7 +357,7 @@ Spec.GHC.StackSpec build-depends: array >= 0.3 && < 0.6 , base-compat >= 0.8.2 && < 1 - , base-orphans >= 0.5.2 && < 1 + , base-orphans >= 0.6 && < 0.7 , bifunctors >= 5.1 && < 6 , bytestring >= 0.9 && < 0.11 , bytestring-builder @@ -373,7 +371,7 @@ , nats >= 0.1 && < 2 , QuickCheck >= 2.9 && < 3 , quickcheck-instances >= 0.1 && < 0.4 - , semigroups >= 0.17 && < 1 + , semigroups >= 0.18.3 && < 1 , tagged >= 0.8.3 && < 1 , text >= 0.11.1 && < 1.3 , th-lift >= 0.7.6 && < 1 @@ -387,8 +385,8 @@ build-depends: base >= 4.3 && < 4.9 if flag(template-haskell-2-11) - build-depends: template-haskell >= 2.11 && < 2.12 - , ghc-boot-th + build-depends: template-haskell >= 2.11 && < 2.13 + , ghc-boot-th >= 8.0 && < 8.3 else build-depends: template-haskell >= 2.5 && < 2.11 @@ -401,15 +399,14 @@ if flag(developer) hs-source-dirs: src else - build-depends: text-show == 3.4.1.1 + build-depends: text-show - hs-source-dirs: tests + hs-source-dirs: tests, shared default-language: Haskell2010 ghc-options: -Wall -threaded -rtsopts include-dirs: include includes: generic.h , overlap.h - , utils.h benchmark bench if impl(ghc < 7.4) @@ -443,8 +440,8 @@ build-depends: base >= 4.5 && < 4.9 if flag(template-haskell-2-11) - build-depends: template-haskell >= 2.11 && < 2.12 - , ghc-boot-th + build-depends: template-haskell >= 2.11 && < 2.13 + , ghc-boot-th >= 8.0 && < 8.3 else build-depends: template-haskell >= 2.5 && < 2.11 @@ -458,11 +455,9 @@ if flag(developer) hs-source-dirs: src else - build-depends: text-show == 3.4.1.1 + build-depends: text-show - hs-source-dirs: benchmarks + hs-source-dirs: benchmarks, shared default-language: Haskell2010 ghc-options: -Wall include-dirs: include - includes: inline.h - , utils.h