text-show 3.6.2 → 3.7
raw patch · 6 files changed
+75/−26 lines, 6 files
Files
- CHANGELOG.md +5/−0
- src/TextShow/Generic.hs +14/−4
- src/TextShow/Options.hs +16/−3
- src/TextShow/TH/Internal.hs +33/−14
- tests/Instances/Options.hs +3/−3
- text-show.cabal +4/−2
CHANGELOG.md view
@@ -1,3 +1,8 @@+## 3.7 [2017.12.07]+* Use `EmptyCase` on GHC 7.8 or later for `TextShow(1)` instances for empty data types that are derived using `TextShow.Generic`.+* Derived `TextShow(1)(2)` instances (using `TextShow.TH`) will now force their argument instead of simply `error`ing.+* Add `emptyCaseBehavior` to `Options`, which configures whether derived instances (using `TextShow.TH`) for empty data types should use the `EmptyCase` extension (this is disabled by default).+ ### 3.6.2 [2017.06.18] * Drop support for GHC 7.0 and 7.2 * Require `QuickCheck-2.10`/`quickcheck-instances-0.13.6` or later
src/TextShow/Generic.hs view
@@ -21,6 +21,10 @@ {-# LANGUAGE PolyKinds #-} #endif +#if __GLASGOW_HASKELL__ >= 708+{-# LANGUAGE EmptyCase #-}+#endif+ #if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE DeriveLift #-} #endif@@ -325,12 +329,18 @@ hash_prec = id #endif +#if __GLASGOW_HASKELL__ >= 708+#define EMPTY_CASE(x) case x of {}+#else+#define EMPTY_CASE(x) case x of !_ -> undefined+#endif+ #define GTEXT_SHOW(text_type,show_funs,no_show_funs,show1_funs,one_hash,two_hash,hash_prec,gtext_show,gshow_prec,gtext_show_con,gshow_prec_con,show_prec,lift_show_prec,show_space,show_paren,show_list_with,from_char,from_string) \ {- | A 'show_funs' value either stores nothing (for 'TextShow') or it stores \ the two function arguments that show occurrences of the type parameter (for \ 'TextShow1'). \ \-/Since: 3.4/ \+/Since: 3.4/ \ -}; \ data show_funs arity a where { \ no_show_funs :: show_funs Zero a \@@ -347,7 +357,7 @@ used. @'gtext_show' 'Zero'@ indicates 'TextShow' behavior, and \ @'gtext_show' 'One'@ indicates 'TextShow1' behavior. \ \-/Since: 3.4/ \+/Since: 3.4/ \ -}; \ class gtext_show arity f where { \ {- | This is used as the default generic implementation of 'show_prec' (if the \@@ -363,11 +373,11 @@ }; \ \ instance gtext_show Zero V1 where { \- gshow_prec _ _ !_ = error "Void show_prec" \+ gshow_prec _ _ x = EMPTY_CASE(x) \ }; \ \ instance gtext_show One V1 where { \- gshow_prec _ _ !_ = error "Void lift_show_prec" \+ gshow_prec _ _ x = EMPTY_CASE(x) \ }; \ \ instance (gtext_show arity f, gtext_show arity g) => gtext_show arity (f :+: g) where { \
src/TextShow/Options.hs view
@@ -18,7 +18,7 @@ #endif {-|-Module: TextShow.FromStringTextShow+Module: TextShow.Options Copyright: (C) 2014-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott@@ -41,10 +41,20 @@ -- | Options that specify how to derive 'TextShow' instances using Template Haskell. -- -- /Since: 3.4/-newtype Options = Options+data Options = Options { genTextMethods :: GenTextMethods -- ^ When Template Haskell should generate definitions for methods which -- return @Text@?+ --+ -- /Since: 3.4/+ , emptyCaseBehavior :: Bool+ -- ^ If 'True', derived instances for empty data types (i.e., ones with+ -- no data constructors) will use the @EmptyCase@ language extension.+ -- If 'False', derived instances will simply use 'seq' instead.+ -- (This has no effect on GHCs before 7.8, since @EmptyCase@ is only+ -- available in 7.8 or later.)+ --+ -- /Since: 3.7/ } deriving ( Data , Eq , Generic@@ -84,7 +94,10 @@ -- -- /Since: 3.4/ defaultOptions :: Options-defaultOptions = Options { genTextMethods = SometimesTextMethods }+defaultOptions =+ Options { genTextMethods = SometimesTextMethods+ , emptyCaseBehavior = False+ } -------------------------------------------------------------------------------
src/TextShow/TH/Internal.hs view
@@ -349,14 +349,14 @@ -- -- /Since: 2/ makeShowtPrec :: Name -> Q Exp-makeShowtPrec = makeShowbPrecClass TextShow ShowtPrec+makeShowtPrec = makeShowbPrecClass TextShow ShowtPrec defaultOptions -- | Generates a lambda expression which behaves like 'showtlPrec' (without -- requiring a 'TextShow' instance). -- -- /Since: 2/ makeShowtlPrec :: Name -> Q Exp-makeShowtlPrec = makeShowbPrecClass TextShow ShowtlPrec+makeShowtlPrec = makeShowbPrecClass TextShow ShowtlPrec defaultOptions -- | Generates a lambda expression which behaves like 'showtList' (without requiring a -- 'TextShow' instance).@@ -384,14 +384,14 @@ -- -- /Since: 2/ makeShowbPrec :: Name -> Q Exp-makeShowbPrec = makeShowbPrecClass TextShow ShowbPrec+makeShowbPrec = makeShowbPrecClass TextShow ShowbPrec defaultOptions -- | Generates a lambda expression which behaves like 'liftShowbPrec' (without -- requiring a 'TextShow1' instance). -- -- /Since: 3/ makeLiftShowbPrec :: Name -> Q Exp-makeLiftShowbPrec = makeShowbPrecClass TextShow1 ShowbPrec+makeLiftShowbPrec = makeShowbPrecClass TextShow1 ShowbPrec defaultOptions -- | Generates a lambda expression which behaves like 'showbPrec1' (without -- requiring a 'TextShow1' instance).@@ -405,7 +405,7 @@ -- -- /Since: 3/ makeLiftShowbPrec2 :: Name -> Q Exp-makeLiftShowbPrec2 = makeShowbPrecClass TextShow2 ShowbPrec+makeLiftShowbPrec2 = makeShowbPrecClass TextShow2 ShowbPrec defaultOptions -- | Generates a lambda expression which behaves like 'showbPrec2' (without -- requiring a 'TextShow2' instance).@@ -491,15 +491,15 @@ genMethod method methodName = funD methodName [ clause []- (normalB $ makeTextShowForCons tsClass method vars cons)+ (normalB $ makeTextShowForCons tsClass method opts vars cons) [] ] -- | Generates a lambda expression which behaves like showbPrec (for TextShow), -- liftShowbPrec (for TextShow1), or liftShowbPrec2 (for TextShow2).-makeShowbPrecClass :: TextShowClass -> TextShowFun -> Name -> Q Exp-makeShowbPrecClass tsClass tsFun name = do+makeShowbPrecClass :: TextShowClass -> TextShowFun -> Options -> Name -> Q Exp+makeShowbPrecClass tsClass tsFun opts name = do info <- reifyDatatype name case info of DatatypeInfo { datatypeContext = ctxt@@ -512,14 +512,13 @@ -- or not the provided datatype can actually have showbPrec/liftShowbPrec/etc. -- implemented for it, and produces errors if it can't. buildTypeInstance tsClass parentName ctxt vars variant- `seq` makeTextShowForCons tsClass tsFun vars cons+ >> makeTextShowForCons tsClass tsFun opts vars cons -- | Generates a lambda expression for showbPrec/liftShowbPrec/etc. for the -- given constructors. All constructors must be from the same type.-makeTextShowForCons :: TextShowClass -> TextShowFun -> [Type] -> [ConstructorInfo]+makeTextShowForCons :: TextShowClass -> TextShowFun -> Options -> [Type] -> [ConstructorInfo] -> Q Exp-makeTextShowForCons _ _ _ [] = error "Must have at least one data constructor"-makeTextShowForCons tsClass tsFun vars cons = do+makeTextShowForCons tsClass tsFun opts vars cons = do p <- newName "p" value <- newName "value" sps <- newNameList "sp" $ fromEnum tsClass@@ -528,13 +527,33 @@ spsAndSls = interleave sps sls lastTyVars = map varTToName $ drop (length vars - fromEnum tsClass) vars splMap = Map.fromList $ zip lastTyVars spls- matches <- mapM (makeTextShowForCon p tsClass tsFun splMap) cons++ makeFun+ | null cons && emptyCaseBehavior opts && ghc7'8OrLater+ = caseE (varE value) []++ | null cons+ = appE (varE 'seq) (varE value) `appE`+ appE (varE 'error)+ (stringE $ "Void " ++ nameBase (showPrecName tsClass tsFun))++ | otherwise+ = caseE (varE value)+ (map (makeTextShowForCon p tsClass tsFun splMap) cons)+ lamE (map varP $ spsAndSls ++ [p, value]) . appsE $ [ varE $ showPrecConstName tsClass tsFun- , caseE (varE value) (map return matches)+ , makeFun ] ++ map varE spsAndSls ++ [varE p, varE value]+ where+ ghc7'8OrLater :: Bool+#if __GLASGOW_HASKELL__ >= 708+ ghc7'8OrLater = True+#else+ ghc7'8OrLater = False+#endif -- | Generates a lambda expression for howbPrec/liftShowbPrec/etc. for a -- single constructor.
tests/Instances/Options.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-|@@ -14,10 +12,12 @@ -} module Instances.Options () where +import Instances.Utils.GenericArbitrary (genericArbitrary) import Test.QuickCheck (Arbitrary(..), arbitraryBoundedEnum) import TextShow.TH (Options(..), GenTextMethods) -deriving instance Arbitrary Options+instance Arbitrary Options where+ arbitrary = genericArbitrary instance Arbitrary GenTextMethods where arbitrary = arbitraryBoundedEnum
text-show.cabal view
@@ -1,5 +1,5 @@ name: text-show-version: 3.6.2+version: 3.7 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@@ -49,7 +49,7 @@ , GHC == 7.8.4 , GHC == 7.10.3 , GHC == 8.0.2- , GHC == 8.2.1+ , GHC == 8.2.2 extra-source-files: CHANGELOG.md, README.md, include/*.h cabal-version: >=1.10 @@ -336,6 +336,8 @@ -- Only exports tests if base >= 4.9 Spec.GHC.StackSpec++ TextShow.TH.Names build-depends: array >= 0.3 && < 0.6 , base-compat >= 0.8.2 && < 1 , base-orphans >= 0.6 && < 0.7