text-show 3.4 → 3.4.1
raw patch · 21 files changed
+70/−298 lines, 21 filesdep ~QuickCheckdep ~deriving-compatdep ~text-show
Dependency ranges changed: QuickCheck, deriving-compat, text-show
Files
- CHANGELOG.md +4/−0
- src/TextShow/Generic.hs +14/−4
- src/TextShow/TH/Internal.hs +11/−11
- src/TextShow/Utils.hs +26/−6
- tests/Derived/Records.hs +4/−4
- tests/Instances/Control/Applicative.hs +0/−27
- tests/Instances/Data/Functor/Identity.hs +0/−26
- tests/Instances/Data/List/NonEmpty.hs +1/−13
- tests/Instances/Data/Monoid.hs +0/−36
- tests/Instances/Data/Tuple.hs +0/−67
- tests/Instances/Data/Version.hs +0/−29
- tests/Instances/Numeric/Natural.hs +0/−35
- tests/Spec/Control/ApplicativeSpec.hs +0/−2
- tests/Spec/Data/Functor/IdentitySpec.hs +0/−2
- tests/Spec/Data/MonoidSpec.hs +0/−2
- tests/Spec/Data/VersionSpec.hs +0/−2
- tests/Spec/GHC/RTS/FlagsSpec.hs +2/−2
- tests/Spec/Numeric/NaturalSpec.hs +0/−2
- tests/Spec/System/IOSpec.hs +2/−2
- tests/Spec/Utils.hs +1/−16
- text-show.cabal +5/−10
CHANGELOG.md view
@@ -1,3 +1,7 @@+### 3.4.1 [2016.10.20]+* Require `QuickCheck-2.9` or later+* Fix bug in which infix record selectors weren't shown with parentheses+ ## 3.4 * The default definitions of `showt` and `showtl` were changed to `showtPrec 0` and `showtlPrec 0`, respectively * `deriveTextShowOptions`, `deriveTextShow1Options`, and `deriveTextShow2Options` added to `TextShow.TH`, which allow further configuration of how `TextShow(1)(2)` instances should be derived using the new `Options` data type. `Options` itself contains `GenTextMethods`, which configures whether manual implementations of `TextShow` should implement the methods that return strict and lazy `Text`.
src/TextShow/Generic.hs view
@@ -118,7 +118,7 @@ liftShowtPrec, liftShowtlPrec) import TextShow.Instances () import TextShow.TH.Internal (deriveTextShow)-import TextShow.Utils (isInfixTypeCon, isTupleString)+import TextShow.Utils (isInfixDataCon, isSymVar, isTupleString) #include "inline.h" @@ -394,7 +394,7 @@ (if conIsTuple c \ then mempty \ else let cn = conName c \- in show_paren (isInfixTypeCon cn) $ from_string cn) \+ in show_paren (isInfixDataCon cn) $ from_string cn) \ <> (if isNullary x || conIsTuple c \ then mempty \ else from_char ' ') \@@ -460,9 +460,19 @@ instance (Selector s, gtext_show_con arity f) => gtext_show_con arity (S1 s f) where { \ gshow_prec_con t sfs p sel@(M1 x) \ | selName sel == "" = gshow_prec_con t sfs p x \- | otherwise = from_string (selName sel) \+ | otherwise = infixRec \ <> " = " \ <> gshow_prec_con t sfs 0 x \+ where { \+ infixRec :: text_type \+ ; infixRec | isSymVar selectorName \+ = from_char '(' <> from_string selectorName <> from_char ')' \+ | otherwise \+ = from_string selectorName \+ \+ ; selectorName :: String \+ ; selectorName = selName sel \+ } \ }; \ \ instance (gtext_show_con arity f, gtext_show_con arity g) \@@ -479,7 +489,7 @@ <> gshow_prec_con t sfs p b \ where { \ infixOp :: text_type \- ; infixOp = if isInfixTypeCon o \+ ; infixOp = if isInfixDataCon o \ then from_string o \ else from_char '`' <> from_string o <> from_char '`' \ } \
src/TextShow/TH/Internal.hs view
@@ -78,9 +78,6 @@ import qualified Data.Text.Lazy.IO as TL (putStrLn, hPutStrLn) import GHC.Exts (Char(..), Double(..), Float(..), Int(..), Word(..))-#if __GLASGOW_HASKELL__ >= 800-import GHC.Lexeme (startsConSym)-#endif import GHC.Prim (Char#, Double#, Float#, Int#, Word#) import GHC.Show (appPrec, appPrec1) @@ -95,7 +92,7 @@ showbListWith, showbParen, showbSpace, showtParen, showtSpace, showtlParen, showtlSpace) import TextShow.Options (Options(..), GenTextMethods(..), defaultOptions)-import TextShow.Utils (isInfixTypeCon, isTupleString)+import TextShow.Utils (isInfixDataCon, isSymVar, isTupleString) ------------------------------------------------------------------------------- -- User-facing API@@ -597,10 +594,13 @@ args <- newNameList "arg" $ length argTys let showArgs = concatMap (\((argName, _, _), argTy, arg)- -> [ varE (fromStringName tsFun) `appE` stringE (nameBase argName ++ " = ")- , makeTextShowForArg 0 tsClass tsFun conName tvMap argTy arg- , varE (fromStringName tsFun) `appE` stringE ", "- ]+ -> let argNameBase = nameBase argName+ infixRec = showParen (isSymVar argNameBase)+ (showString argNameBase) ""+ in [ varE (fromStringName tsFun) `appE` stringE (infixRec ++ " = ")+ , makeTextShowForArg 0 tsClass tsFun conName tvMap argTy arg+ , varE (fromStringName tsFun) `appE` stringE ", "+ ] ) (zip3 ts argTys args) braceCommaArgs = (varE (singletonName tsFun) `appE` charE '{') : take (length showArgs - 1) showArgs@@ -638,7 +638,7 @@ let opName = nameBase conName infixOpE = appE (varE $ fromStringName tsFun) . stringE $- if isInfixTypeCon opName+ if isInfixDataCon opName then " " ++ opName ++ " " else " `" ++ opName ++ "` " @@ -660,7 +660,7 @@ let con :: Name -> Q Con con conName = do mbFi <- reifyFixity conName- return $ if startsConSym (head $ nameBase conName)+ return $ if isInfixDataCon (nameBase conName) && length ts == 2 && isJust mbFi then let [t1, t2] = ts in InfixC t1 conName t2@@ -1583,7 +1583,7 @@ parenInfixConName :: Name -> ShowS parenInfixConName conName = let conNameBase = nameBase conName- in showParen (isInfixTypeCon conNameBase) $ showString conNameBase+ in showParen (isInfixDataCon conNameBase) $ showString conNameBase -- | Extracts the kind from a TyVarBndr. tvbKind :: TyVarBndr -> Kind
src/TextShow/Utils.hs view
@@ -14,7 +14,8 @@ module TextShow.Utils ( coerce , i2d- , isInfixTypeCon+ , isInfixDataCon+ , isSymVar , isTupleString , lengthB , toString@@ -41,6 +42,12 @@ import Unsafe.Coerce (unsafeCoerce) #endif +#if defined(MIN_VERSION_ghc_boot_th)+import GHC.Lexeme (startsVarSym)+#else+import Data.Char (isSymbol, ord)+#endif+ -- | On GHC 7.8 and later, this is 'C.coerce' from "Data.Coerce". Otherwise, it's -- 'unsafeCoerce'. #if __GLASGOW_HASKELL__ >= 708@@ -56,12 +63,25 @@ i2d (I# i#) = C# (chr# (ord# '0'# +# i#)) {-# INLINE i2d #-} --- | Checks if a 'String' names a valid Haskell infix type constructor (i.e., does+-- | Checks if a 'String' names a valid Haskell infix data constructor (i.e., does -- it begin with a colon?).-isInfixTypeCon :: String -> Bool-isInfixTypeCon (':':_) = True-isInfixTypeCon _ = False-{-# INLINE isInfixTypeCon #-}+isInfixDataCon :: String -> Bool+isInfixDataCon (':':_) = True+isInfixDataCon _ = False+{-# INLINE isInfixDataCon #-}++-- | Checks if a 'String' names a valid Haskell infix, non-constructor function.+isSymVar :: String -> Bool+isSymVar "" = False+isSymVar (c : _) = startsVarSym c++#if !defined(MIN_VERSION_ghc_boot_th)+startsVarSym :: Char -> Bool+startsVarSym c = startsVarSymASCII c || (ord c > 0x7f && isSymbol c) -- Infix Ids++startsVarSymASCII :: Char -> Bool+startsVarSymASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"+#endif -- | Checks if a 'String' represents a tuple (other than '()') isTupleString :: String -> Bool
tests/Derived/Records.hs view
@@ -50,8 +50,8 @@ ------------------------------------------------------------------------------- infixl 4 :@:-data TyCon a b = TyConPrefix { tc1 :: a, tc2 :: b }- | (:@:) { tc3 :: b, tc4 :: a }+data TyCon a b = TyConPrefix { tc1 :: a, tc2 :: b }+ | (:@:) { tc3 :: b, (##) :: a } deriving ( Show #if __GLASGOW_HASKELL__ >= 702 , Generic@@ -66,8 +66,8 @@ data family TyFamily y z :: * infixl 4 :!:-data instance TyFamily a b = TyFamilyPrefix { tf1 :: a, tf2 :: b }- | (:!:) { tf3 :: b, tf4 :: a }+data instance TyFamily a b = TyFamilyPrefix { tf1 :: a, tf2 :: b }+ | (:!:) { tf3 :: b, (###) :: a } deriving ( Show #if __GLASGOW_HASKELL__ >= 706 , Generic
− tests/Instances/Control/Applicative.hs
@@ -1,27 +0,0 @@-{-# LANGUAGE CPP #-}--#if !(MIN_VERSION_QuickCheck(2,9,0))-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-#endif--{-|-Module: Instances.Control.Applicative-Copyright: (C) 2014-2016 Ryan Scott-License: BSD-style (see the file LICENSE)-Maintainer: Ryan Scott-Stability: Provisional-Portability: GHC--'Arbitrary' instances for data types in the "Control.Applicative" module.--}-module Instances.Control.Applicative () where--#if !(MIN_VERSION_QuickCheck(2,9,0))-import Control.Applicative (Const(..), ZipList(..))-import Test.QuickCheck (Arbitrary)--deriving instance Arbitrary a => Arbitrary (Const a b)-deriving instance Arbitrary a => Arbitrary (ZipList a)-#endif
− tests/Instances/Data/Functor/Identity.hs
@@ -1,26 +0,0 @@-{-# LANGUAGE CPP #-}--#if !(MIN_VERSION_QuickCheck(2,9,0))-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-#endif--{-|-Module: Instances.Data.Functor.Identity-Copyright: (C) 2014-2016 Ryan Scott-License: BSD-style (see the file LICENSE)-Maintainer: Ryan Scott-Stability: Provisional-Portability: GHC--'Arbitrary' instance for 'Identity'.--}-module Instances.Data.Functor.Identity () where--#if !(MIN_VERSION_QuickCheck(2,9,0))-import Data.Functor.Identity (Identity(..))-import Test.QuickCheck (Arbitrary)--deriving instance Arbitrary a => Arbitrary (Identity a)-#endif
tests/Instances/Data/List/NonEmpty.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -14,19 +13,8 @@ -} module Instances.Data.List.NonEmpty () where -import Data.List.NonEmpty (NonEmpty(..))-+import Data.List.NonEmpty (NonEmpty) import Text.Show.Deriving (deriveShow1)--#if !(MIN_VERSION_QuickCheck(2,9,0))-import Prelude ()-import Prelude.Compat--import Test.QuickCheck (Arbitrary(..))--instance Arbitrary a => Arbitrary (NonEmpty a) where- arbitrary = (:|) <$> arbitrary <*> arbitrary-#endif -- TODO: Replace this with a non-orphan instance $(deriveShow1 ''NonEmpty)
− tests/Instances/Data/Monoid.hs
@@ -1,36 +0,0 @@-{-# LANGUAGE CPP #-}--#if !(MIN_VERSION_QuickCheck(2,9,0))-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-#endif--{-|-Module: Instances.Data.Monoid-Copyright: (C) 2014-2016 Ryan Scott-License: BSD-style (see the file LICENSE)-Maintainer: Ryan Scott-Stability: Provisional-Portability: GHC--'Arbitrary' instances for data types in the "Data.Monoid" module.--}-module Instances.Data.Monoid () where--#if !(MIN_VERSION_QuickCheck(2,9,0))-import Data.Monoid-import Test.QuickCheck (Arbitrary)--deriving instance Arbitrary All-deriving instance Arbitrary Any-deriving instance Arbitrary a => Arbitrary (Dual a)-deriving instance Arbitrary a => Arbitrary (First a)-deriving instance Arbitrary a => Arbitrary (Last a)-deriving instance Arbitrary a => Arbitrary (Product a)-deriving instance Arbitrary a => Arbitrary (Sum a)-# if MIN_VERSION_base(4,8,0)-deriving instance Arbitrary (f a) => Arbitrary (Alt f a)-# endif-#endif
tests/Instances/Data/Tuple.hs view
@@ -18,73 +18,6 @@ import Test.QuickCheck (Arbitrary(..)) -#if !(MIN_VERSION_QuickCheck(2,9,0))-instance ( Arbitrary a- , Arbitrary b- , Arbitrary c- , Arbitrary d- , Arbitrary e- , Arbitrary f- ) => Arbitrary (a, b, c, d, e, f) where- arbitrary = (,,,,,)- <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary- <*> arbitrary--instance ( Arbitrary a- , Arbitrary b- , Arbitrary c- , Arbitrary d- , Arbitrary e- , Arbitrary f- , Arbitrary g- ) => Arbitrary (a, b, c, d, e, f, g) where- arbitrary = (,,,,,,)- <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary- <*> arbitrary <*> arbitrary--instance ( Arbitrary a- , Arbitrary b- , Arbitrary c- , Arbitrary d- , Arbitrary e- , Arbitrary f- , Arbitrary g- , Arbitrary h- ) => Arbitrary (a, b, c, d, e, f, g, h) where- arbitrary = (,,,,,,,)- <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary- <*> arbitrary <*> arbitrary <*> arbitrary--instance ( Arbitrary a- , Arbitrary b- , Arbitrary c- , Arbitrary d- , Arbitrary e- , Arbitrary f- , Arbitrary g- , Arbitrary h- , Arbitrary i- ) => Arbitrary (a, b, c, d, e, f, g, h, i) where- arbitrary = (,,,,,,,,)- <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary- <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary--instance ( Arbitrary a- , Arbitrary b- , Arbitrary c- , Arbitrary d- , Arbitrary e- , Arbitrary f- , Arbitrary g- , Arbitrary h- , Arbitrary i- , Arbitrary j- ) => Arbitrary (a, b, c, d, e, f, g, h, i, j) where- arbitrary = (,,,,,,,,,)- <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary- <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary-#endif- instance ( Arbitrary a , Arbitrary b , Arbitrary c
− tests/Instances/Data/Version.hs
@@ -1,29 +0,0 @@-{-# LANGUAGE CPP #-}--#if !(MIN_VERSION_QuickCheck(2,9,0))-{-# OPTIONS_GHC -fno-warn-orphans #-}-#endif--{-|-Module: Instances.Data.Version-Copyright: (C) 2014-2016 Ryan Scott-License: BSD-style (see the file LICENSE)-Maintainer: Ryan Scott-Stability: Provisional-Portability: GHC--'Arbitrary' instance for 'Version'.--}-module Instances.Data.Version () where--#if !(MIN_VERSION_QuickCheck(2,9,0))-import Data.Version (Version(..))--import Prelude ()-import Prelude.Compat--import Test.QuickCheck (Arbitrary(..))--instance Arbitrary Version where- arbitrary = Version <$> arbitrary <*> arbitrary-#endif
− tests/Instances/Numeric/Natural.hs
@@ -1,35 +0,0 @@-{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--{-|-Module: Instances.Numeric.Natural-Copyright: (C) 2014-2016 Ryan Scott-License: BSD-style (see the file LICENSE)-Maintainer: Ryan Scott-Stability: Provisional-Portability: GHC--'Arbitrary' instance 'Natural' (if one isn't already defined).--}-module Instances.Numeric.Natural () where---- Copied from @QuickCheck@--#if !(MIN_VERSION_QuickCheck(2,8,0)) || !(MIN_VERSION_base(4,8,0))-import Numeric.Natural (Natural)-import Test.QuickCheck (Arbitrary(..), Gen,- choose, shrinkIntegral, sized, suchThat)--instance Arbitrary Natural where- arbitrary = arbitrarySizedNatural- shrink = shrinkIntegral---- | Generates a natural number. The number's maximum value depends on--- the size parameter.-arbitrarySizedNatural :: Integral a => Gen a-arbitrarySizedNatural = sized $ \n ->- inBounds fromInteger (choose (0, toInteger n))--inBounds :: Integral a => (Integer -> a) -> Gen Integer -> Gen a-inBounds fi g = fmap fi (g `suchThat` (\x -> toInteger (fi x) == x))-#endif
tests/Spec/Control/ApplicativeSpec.hs view
@@ -17,8 +17,6 @@ import Generics.Deriving.Instances () -import Instances.Control.Applicative ()- import Spec.Utils (prop_matchesTextShow, prop_matchesTextShow1, prop_genericTextShow, prop_genericTextShow1)
tests/Spec/Data/Functor/IdentitySpec.hs view
@@ -14,8 +14,6 @@ import Data.Functor.Identity (Identity) -import Instances.Data.Functor.Identity ()- import Spec.Utils (prop_matchesTextShow1) import Test.Hspec (Spec, describe, hspec, parallel)
tests/Spec/Data/MonoidSpec.hs view
@@ -16,8 +16,6 @@ import Generics.Deriving.Instances () -import Instances.Data.Monoid ()- import Spec.Utils (prop_matchesTextShow, prop_genericTextShow, prop_genericTextShow1) import Test.Hspec (Spec, describe, hspec, parallel)
tests/Spec/Data/VersionSpec.hs view
@@ -2,8 +2,6 @@ import Data.Version (Version, showVersion) -import Instances.Data.Version ()- import Spec.Utils (prop_matchesTextShow) import Test.Hspec (Spec, describe, hspec, parallel)
tests/Spec/GHC/RTS/FlagsSpec.hs view
@@ -22,11 +22,11 @@ #if MIN_VERSION_base(4,8,0) import GHC.RTS.Flags -import Spec.Utils (ioProperty, prop_matchesTextShow)+import Spec.Utils (prop_matchesTextShow) import Test.Hspec (describe) import Test.Hspec.QuickCheck (prop)-import Test.QuickCheck (Property)+import Test.QuickCheck (Property, ioProperty) #endif main :: IO ()
tests/Spec/Numeric/NaturalSpec.hs view
@@ -10,8 +10,6 @@ -} module Spec.Numeric.NaturalSpec (main, spec) where -import Instances.Numeric.Natural ()- import Numeric.Natural (Natural) import Spec.Utils (prop_matchesTextShow)
tests/Spec/System/IOSpec.hs view
@@ -22,14 +22,14 @@ import Prelude () import Prelude.Compat -import Spec.Utils (ioProperty, prop_matchesTextShow)+import Spec.Utils (prop_matchesTextShow) import System.IO (BufferMode, IOMode, HandlePosn, Newline, NewlineMode, SeekMode, Handle, mkTextEncoding) import Test.Hspec (Spec, describe, hspec, parallel) import Test.Hspec.QuickCheck (prop)-import Test.QuickCheck (Property, generate, oneof)+import Test.QuickCheck (Property, generate, ioProperty, oneof) main :: IO () main = hspec spec
tests/Spec/Utils.hs view
@@ -12,8 +12,7 @@ Testing-related utility functions. -} module Spec.Utils (- ioProperty- , prop_matchesTextShow+ prop_matchesTextShow , prop_matchesTextShow1 #if defined(NEW_FUNCTOR_CLASSES) , prop_matchesTextShow2@@ -26,26 +25,12 @@ import Generics.Deriving.Base -#if MIN_VERSION_QuickCheck(2,7,0)-import qualified Test.QuickCheck as QC (ioProperty)-#else-import Test.QuickCheck (morallyDubiousIOProperty)-#endif-import Test.QuickCheck (Property, Testable)- import TextShow (TextShow(..), TextShow1(..), showbPrec1, fromString) import TextShow.Generic #if defined(NEW_FUNCTOR_CLASSES) import Data.Functor.Classes (Show2, showsPrec2) import TextShow (TextShow2(..), showbPrec2)-#endif--ioProperty :: Testable prop => IO prop -> Property-#if MIN_VERSION_QuickCheck(2,7,0)-ioProperty = QC.ioProperty-#else-ioProperty = morallyDubiousIOProperty #endif -- | Verifies that a type's 'Show' instances coincide for both 'String's and 'Text',
text-show.cabal view
@@ -1,5 +1,5 @@ name: text-show-version: 3.4+version: 3.4.1 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@@ -217,7 +217,6 @@ Derived.Records Derived.TypeSynonyms - Instances.Control.Applicative Instances.Control.Concurrent Instances.Control.Exception Instances.Control.Monad.ST@@ -227,24 +226,20 @@ Instances.Data.Dynamic Instances.Data.Floating Instances.Data.Functor.Compose- Instances.Data.Functor.Identity Instances.Data.Functor.Product Instances.Data.Functor.Sum Instances.Data.List.NonEmpty- Instances.Data.Monoid Instances.Data.Ord Instances.Data.Proxy Instances.Data.Semigroup Instances.Data.Text Instances.Data.Tuple Instances.Data.Typeable- Instances.Data.Version Instances.Foreign.C.Types Instances.Foreign.Ptr Instances.FromStringTextShow Instances.Generic Instances.GHC.Generics- Instances.Numeric.Natural Instances.Options Instances.System.Exit Instances.System.IO@@ -370,13 +365,13 @@ , bytestring-builder , containers >= 0.1 && < 0.6 , contravariant >= 0.5 && < 2- , deriving-compat >= 0.3 && < 1+ , deriving-compat >= 0.3.4 && < 1 , generic-deriving >= 1.11 && < 2 , ghc-prim , hspec >= 2 && < 3 , integer-gmp , nats >= 0.1 && < 2- , QuickCheck >= 2.5 && < 3+ , QuickCheck >= 2.9 && < 3 , quickcheck-instances >= 0.1 && < 0.4 , semigroups >= 0.17 && < 1 , tagged >= 0.8.3 && < 1@@ -406,7 +401,7 @@ if flag(developer) hs-source-dirs: src else- build-depends: text-show == 3.4+ build-depends: text-show == 3.4.1 hs-source-dirs: tests default-language: Haskell2010@@ -469,7 +464,7 @@ if flag(developer) hs-source-dirs: src else- build-depends: text-show == 3.4+ build-depends: text-show == 3.4.1 hs-source-dirs: benchmarks default-language: Haskell2010