mirror of
https://github.com/google/ghc-source-gen.git
synced 2024-09-11 22:07:09 +03:00
Add standaloneDeriving
This commit is contained in:
parent
bb6061cef4
commit
f4476d9e61
@ -30,6 +30,10 @@ module GHC.SourceGen.Decl
|
||||
#if MIN_VERSION_ghc(8,6,0)
|
||||
, derivingVia
|
||||
#endif
|
||||
, standaloneDeriving
|
||||
, standaloneDerivingStock
|
||||
, standaloneDerivingNewtype
|
||||
, standaloneDerivingAnyclass
|
||||
-- * Class declarations
|
||||
, class'
|
||||
, ClassDecl
|
||||
@ -56,8 +60,10 @@ import GHC.Hs.Types
|
||||
( ConDeclField(..)
|
||||
, FieldOcc(..)
|
||||
, HsConDetails(..)
|
||||
, HsImplicitBndrs (..)
|
||||
, HsSrcBang(..)
|
||||
, HsType(..)
|
||||
, HsWildCardBndrs (..)
|
||||
#if MIN_VERSION_ghc(8,8,0)
|
||||
, HsArg(..)
|
||||
#endif
|
||||
@ -411,6 +417,31 @@ derivingVia :: HsType' -> [HsType'] -> HsDerivingClause'
|
||||
derivingVia t = derivingWay (Just $ ViaStrategy $ sigType t)
|
||||
#endif
|
||||
|
||||
standaloneDeriving :: HsType' -> HsDecl'
|
||||
standaloneDeriving = standaloneDerivingWay Nothing
|
||||
|
||||
standaloneDerivingStock :: HsType' -> HsDecl'
|
||||
standaloneDerivingStock = standaloneDerivingWay (Just StockStrategy)
|
||||
|
||||
standaloneDerivingNewtype :: HsType' -> HsDecl'
|
||||
standaloneDerivingNewtype = standaloneDerivingWay (Just NewtypeStrategy)
|
||||
|
||||
standaloneDerivingAnyclass :: HsType' -> HsDecl'
|
||||
standaloneDerivingAnyclass = standaloneDerivingWay (Just AnyclassStrategy)
|
||||
|
||||
standaloneDerivingWay :: Maybe DerivStrategy' -> HsType' -> HsDecl'
|
||||
standaloneDerivingWay way ty = noExt DerivD derivDecl
|
||||
where derivDecl =
|
||||
noExt DerivDecl (hsWC hsIB) (fmap builtLoc way) Nothing
|
||||
hsIB =
|
||||
withPlaceHolder $ noExtOrPlaceHolder HsIB (builtLoc ty)
|
||||
hsWC =
|
||||
#if MIN_VERSION_ghc(8,6,0)
|
||||
noExt HsWC
|
||||
#else
|
||||
id
|
||||
#endif
|
||||
|
||||
-- | Declares multiple pattern signatures of the same type.
|
||||
--
|
||||
-- > pattern F, G :: T
|
||||
|
@ -329,6 +329,18 @@ declsTest dflags = testGroup "Decls"
|
||||
(prefixCon "Const" [field $ var "a"])
|
||||
[deriving' [var "Show"]]
|
||||
]
|
||||
, test "standaloneDeriving"
|
||||
[ "deriving instance Show Int"
|
||||
:~ standaloneDeriving (var "Show" @@ var "Int")
|
||||
, "deriving instance Show a => Show (Maybe a)"
|
||||
:~ standaloneDeriving ([var "Show" @@ var "a"] ==> var "Show" @@ (var "Maybe" @@ var "a"))
|
||||
, "deriving stock instance Show Int"
|
||||
:~ standaloneDerivingStock (var "Show" @@ var "Int")
|
||||
, "deriving newtype instance Show a => Show (Identity a)"
|
||||
:~ standaloneDerivingNewtype ([var "Show" @@ var "a"] ==> var "Show" @@ (var "Identity" @@ var "a"))
|
||||
, "deriving anyclass instance Show Person"
|
||||
:~ standaloneDerivingAnyclass (var "Show" @@ var "Person")
|
||||
]
|
||||
]
|
||||
where
|
||||
test = testDecls dflags
|
||||
|
Loading…
Reference in New Issue
Block a user