Copyright | (C) 2014-2015 Ryan Scott |
---|---|
License | BSD-style (see the file LICENSE) |
Maintainer | Ryan Scott |
Stability | Experimental |
Portability | GHC |
Safe Haskell | None |
Language | Haskell98 |
Functions to mechanically derive Show
instances or splice
show
-related expressions into Haskell source code. You need to enable
the TemplateHaskell
language extension in order to use this module.
Since: 0.3
- deriveShow :: Name -> Q [Dec]
- deriveShowPragmas :: PragmaOptions -> Name -> Q [Dec]
- mkShow :: Name -> Q Exp
- mkShowLazy :: Name -> Q Exp
- mkShowPrec :: Name -> Q Exp
- mkShowPrecLazy :: Name -> Q Exp
- mkShowList :: Name -> Q Exp
- mkShowListLazy :: Name -> Q Exp
- mkShowb :: Name -> Q Exp
- mkShowbPrec :: Name -> Q Exp
- mkShowbList :: Name -> Q Exp
- mkPrint :: Name -> Q Exp
- mkPrintLazy :: Name -> Q Exp
- mkHPrint :: Name -> Q Exp
- mkHPrintLazy :: Name -> Q Exp
- data PragmaOptions = PragmaOptions {
- inlineShowbPrec :: Bool
- inlineShowb :: Bool
- inlineShowbList :: Bool
- specializeTypes :: [Q Type]
- defaultPragmaOptions :: PragmaOptions
- defaultInlineShowbPrec :: PragmaOptions
- defaultInlineShowb :: PragmaOptions
- defaultInlineShowbList :: PragmaOptions
deriveShow
deriveShow
automatically generates a Show
instance declaration for a data
type, a newtype
, a data family instance, or a whole data family. This emulates what
would (hypothetically) happen if you could attach a deriving
clause to the
end of a data declaration.Show
Here are some examples of how to derive simple data types:
{-# LANGUAGE TemplateHaskell #-} import Text.Show.Text.TH (deriveShow) data Letter = A | B | C $(deriveShow
''Letter) -- instance Show Letter where ... newtype Box a = Box a $(deriveShow
''Box) -- instance Show a => Show (Box a) where ...
If you are using template-haskell-2.7.0.0
or later, deriveShow
can also be used
to derive Show
instances for data families. Some examples:
{-# LANGUAGE FlexibleInstances, TemplateHaskell, TypeFamilies #-} import Text.Show.Text.TH (deriveShow) class AssocClass a where data AssocData a instance AssocClass Int where data AssocData Int = AssocDataInt Int Int instance AssocClass Char where newtype AssocData Char = AssocDataChar Char $(deriveShow
'AssocDataChar) -- Only one single quote! -- Generates a Show instance for AssocDataChar, but not AssocDataInt data family DataFam a data instance DataFam Int = DataFamInt Int Int newtype instance DataFam Char = DataFamChar Char $(deriveShow
''DataFam) -- Two double quotes! -- Generates Show instances for all data instances of DataFam -- (DataFamInt and DataFamChar)
Note that at the moment, there are some limitations to this approach:
* deriveShow
makes the assumption that all type variables in a data type require a
Show
constraint when creating the type context. For example, if you have data
Phantom a = Phantom
, then (
will generate deriveShow
''Phantom)instance
, even though Show
a => Show
(Phantom a) where
is not required.
If you want a proper Show
aShow
instance for Phantom
, you will need to use
mkShowbPrec
(see the documentation of the mk
functions for more information).
deriveShow
lacks the ability to properly detect data types with higher-kinded type parameters (e.g.,data HK f a = HK (f a)
). If you wish to deriveShow
instances for these data types, you will need to usemkShowbPrec
(see the documentation of themk
functions for more information).- Some data constructors have arguments whose
Show
instance depends on a typeclass besidesShow
. For example, considernewtype MyFixed a = MyFixed (Fixed a)
.
is aFixed
aShow
instance only ifa
is an instance of bothHasResolution
andShow
. Unfortunately,deriveShow
cannot infer thata
must be an instance ofHasResolution
, so it cannot create aShow
instance forMyFixed
. However, you can usemkShowbPrec
to get around this (see the documentation of themk
functions for more information).
Generates a Show
instance declaration for the given data type or family.
Since: 0.3
:: PragmaOptions | Specifies what pragmas to generate with this instance |
-> Name | Name of the data type to make an instance of |
-> Q [Dec] |
Generates a Show
instance declaration for the given data type or family.
You shouldn't need to use this function unless you know what you are doing.
Unlike deriveShow
, this function allows configuration of whether to inline
showbPrec
, showb
, or showbList
. It also allows for specializing instances
certain types. For example:
{-# LANGUAGE TemplateHaskell #-}
import Text.Show.Text.TH
data ADT a = ADT a
$(deriveShowPragmas defaultInlineShowbPrec
{
specializeTypes = [ [t| ADT Int |] ]
}
''ADT)
This declararation would produce code like this:
instance Show a => Show (ADT a) where {-# INLINE showbPrec #-} {-# SPECIALIZE instance Show (ADT Int) #-} showbPrec = ...
Beware: deriveShow
can generate extremely long code splices, so it may be unwise
to inline in some cases. Use with caution.
Since: 0.5
mk
functions
There may be scenarios in which you want to show an arbitrary data type or family
without having to make the type an instance of Show
. For these cases,
Text.Show.Text.TH provide several functions (all prefixed with mk
) that splice
the appropriate lambda expression into your source code.
As an example, suppose you have data ADT = ADT
, which is not an instance of Show
.
With mkShow
, you can still convert it to Text
:
{-# LANGUAGE OverloadedStrings, TemplateHaskell #-} import Text.Show.Text.TH (mkShow) whichADT :: Bool whichADT = $(mkShow ''ADT) ADT == "ADT"
mk
functions are also useful for creating Show
instances for data types with
sophisticated type parameters. For example, deriveShow
cannot infer the correct type
context for newtype HigherKinded f a = HigherKinded (f a)
, since f
is a
higher-kinded type parameter. However, it is still possible to derive a Show
instance for HigherKinded
without too much trouble using mkShowbPrec
:
{-# LANGUAGE FlexibleContexts, TemplateHaskell #-} import Prelude hiding (Show) import Text.Show.Text (Show(showbPrec)) import Text.Show.Text.TH (mkShowbPrec) instance Show (f a) => Show (HigherKinded f a) where showbPrec = $(mkShowbPrec ''HigherKinded)
mkShow :: Name -> Q Exp Source
Generates a lambda expression which converts the given data type or family
to a strict Text
.
Since: 0.3.1
mkShowLazy :: Name -> Q Exp Source
Generates a lambda expression which converts the given data type or family
to a lazy Text
.
Since: 0.3.1
mkShowPrec :: Name -> Q Exp Source
Generates a lambda expression which converts the given data type or family
to a strict Text
with the given precedence.
Since: 0.3.1
mkShowPrecLazy :: Name -> Q Exp Source
Generates a lambda expression which converts the given data type or family
to a lazy Text
with the given precedence.
Since: 0.3.1
mkShowList :: Name -> Q Exp Source
Generates a lambda expression which converts the given list of data types or
families to a strict Text
in which the values are surrounded by square
brackets and each value is separated by a comma.
Since: 0.5
mkShowListLazy :: Name -> Q Exp Source
Generates a lambda expression which converts the given list of data types or
families to a lazy Text
in which the values are surrounded by square
brackets and each value is separated by a comma.
Since: 0.5
mkShowb :: Name -> Q Exp Source
Generates a lambda expression which converts the given data type or family
to a Builder
.
Since: 0.3.1
mkShowbPrec :: Name -> Q Exp Source
Generates a lambda expression which converts the given data type or family
to a Builder
with the given precedence.
Since: 0.3.1
mkShowbList :: Name -> Q Exp Source
Generates a lambda expression which converts the given list of data types or
families to a Builder
in which the values are surrounded by square brackets
and each value is separated by a comma.
Since: 0.5
mkPrint :: Name -> Q Exp Source
Generates a lambda expression which writes the given data type or family
argument's strict Text
output to the standard output, followed by a newline.
Since: 0.3.1
mkPrintLazy :: Name -> Q Exp Source
Generates a lambda expression which writes the given data type or family
argument's lazy Text
output to the standard output, followed by a newline.
Since: 0.3.1
mkHPrint :: Name -> Q Exp Source
Generates a lambda expression which writes the given data type or family
argument's strict Text
output to the given file handle, followed by a newline.
Since: 0.3.1
mkHPrintLazy :: Name -> Q Exp Source
Generates a lambda expression which writes the given data type or family
argument's lazy Text
output to the given file handle, followed by a newline.
Since: 0.3.1
Advanced pragma options
data PragmaOptions Source
Options that specify what INLINE
or SPECIALIZE
pragmas to generate with
a Show
instance.
Since: 0.5
PragmaOptions | |
|
defaultPragmaOptions :: PragmaOptions Source
Do not generate any pragmas with a Show
instance.
Since: 0.5