| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
GHC.TcPlugin.API.Names
Description
This module provides an optional framework that facilitates name lookup in type-checking plugins, using constrained traversals (similar to the barbies library).
See the ResolveNames typeclass.
Before:
data PluginDefs =
PluginDefs
{ myTyCon :: TyCon
, myClass :: Class
, myPromotedDataCon :: TyCon
}
findMyModule :: MonadTcPlugin m => m Module
findMyModule = do
let modlName = mkModuleName "MyModule"
pkgQual <- resolveImport modlName Nothing
findResult <- findImportedModule modlName pkgQual
case findResult of
Found _ res -> pure res
_ -> error $ "MyPlugin: could not find any module named MyModule."
pluginInit :: TcPluginM Init PluginDefs
pluginInit = do
myModule <- findMyModule
myTyCon <- tcLookupTyCon =<< lookupOrig myModule ( mkTcOcc "MyTyCon" )
myClass <- tcLookupClass =<< lookupOrig myModule ( mkClsOcc "MyClass" )
myPromotedDataCon <- fmap promoteDataCon . tcLookupDataCon =<< lookupOrig myModule ( mkDataOcc "MyDataCon" )
pure ( PluginDefs { .. } )After:
data PluginDefsHKD n =
PluginDefs
{ myTyCon :: Wear n TyCon
, myClass :: Wear n Class
, myPromotedDataCon :: Wear n ( Promoted DataCon )
}
deriving stock Generic
deriving ResolveNames
via Generically1 PluginDefsHKD
type PluginDefs = PluginDefsHKD Resolved
pluginInit :: TcPluginM Init PluginDefs
pluginInit = resolveNames pluginNames
where
pluginNames :: PluginDefsHKD Named
pluginNames =
PluginDefs
{ myTyCon = mkQualified "MyTyCon"
, myClass = mkQualified "MyClass"
, myPromotedDataCon = mkQualified "MyDataCon"
}
mkQualified :: String -> QualifiedName thing
mkQualified str =
Qualified
{ name = str
, module' = mkModuleName "MyModule"
, package = Nothing
}Synopsis
- class ResolveNames (f :: NameResolution -> Type)
- resolveNames :: (MonadTcPlugin m, ResolveNames f) => f 'Named -> m (f 'Resolved)
- type family Wear (n :: NameResolution) (thing :: k) where ...
- data QualifiedName thing = Qualified {}
- data NameResolution
- data Promoted (thing :: k)
- class Lookupable (a :: k) where
- newtype Generically1 (f :: k -> Type) (a :: k) where
- Generically1 :: forall {k} (f :: k -> Type) (a :: k). f a -> Generically1 f a
Documentation
class ResolveNames (f :: NameResolution -> Type) Source #
This class exposes the method resolveNames which will
perform name resolution for all the fields in a datatype.
Example usage: we define a record that will hold
the things we want to look up, using the Wear type family.
For example:
data MyData n
= MyData
{ myClass :: !( Wear n Class )
, myTyCon :: !( Wear n TyCon )
, myDataCon :: !( Wear n DataCon )
, myPromDataCon :: !( Wear n (Promoted DataCon) )
}
deriving stock Generic
deriving ResolveNames
via Generically1 MyDataNow we can specify the names of the things which we want to look up, together with the modules and packages in which they belong:
myNames :: MyData Named
myNames = MyData
{ myClass = QualifiedName "MyClass" "My.Module" ( Just "my-pkg-name" )
, ...
}Then we can call resolveNames:
resolvedNames :: MonadTcPlugin m => m (MyData Resolved) resolvedNames = resolveNames myNames
This returns a record containing the looked up things we want,
e.g. myClass :: Class, myPromDataCon :: TyCon, etc.
Minimal complete definition
resolve_names
Instances
| (Generic (f 'Named), Generic (f 'Resolved), GTraversableC ResolveName (Rep (f 'Named)) (Rep (f 'Resolved))) => ResolveNames (Generically1 f) Source # | |
Defined in GHC.TcPlugin.API.Names Methods resolve_names :: (Coercible res (Generically1 f 'Resolved), MonadTcPlugin m) => Generically1 f 'Named -> m res | |
resolveNames :: (MonadTcPlugin m, ResolveNames f) => f 'Named -> m (f 'Resolved) Source #
Resolve a collection of names.
See ResolveNames for further details.
type family Wear (n :: NameResolution) (thing :: k) where ... Source #
Type-family used for higher-kinded data pattern.
This allows the same record to be re-used,
as explained in the worked example for ResolveNames.
For instance, if one defines:
data MyData n
= MyData
{ myClass :: !( Wear n Class )
, myTyCon :: !( Wear n TyCon )
}then a record of type MyData Named is simply a record of textual names
(a typeclass name and a type-constructor name, with associated module & packages),
whereas a record of type MyData Resolved contains a typeclass's Class
as well as a type-constructor's TyCon.
Equations
| Wear 'Named (thing :: Type) = QualifiedName thing | |
| Wear 'Resolved (Promoted DataCon) = TyCon | |
| Wear 'Resolved (Promoted a :: Type) = TypeError ((('Text "Cannot promote " ':<>: 'ShowType a) ':<>: 'Text ".") ':$$: 'Text "Can only promote 'DataCon's.") :: Type | |
| Wear 'Resolved (thing :: Type) = thing |
data QualifiedName thing Source #
A QualifiedName is the name of something,
together with the names of the module and package it comes from.
data NameResolution Source #
Type-level parameter to Wear type family, for higher-kinded data.
Wear Named thing is the identifier data passed in as an argument.
Wear Resolved thing is the result of name resolving the thing.
This allows users to pass a record of names, of type MyData Named,
and obtain a record of looked-up things, of type MyData Resolved.
Refer to ResolveNames for a worked example.
Instances
| (Generic (f 'Named), Generic (f 'Resolved), GTraversableC ResolveName (Rep (f 'Named)) (Rep (f 'Resolved))) => ResolveNames (Generically1 f) Source # | |
Defined in GHC.TcPlugin.API.Names Methods resolve_names :: (Coercible res (Generically1 f 'Resolved), MonadTcPlugin m) => Generically1 f 'Named -> m res | |
class Lookupable (a :: k) where Source #
Type-class overloading things that can be looked up by name:
- classes,
- data constructors (as well as their promotion),
- type-constructors.
Methods
mkOccName :: String -> OccName Source #
lookup :: MonadTcPlugin m => Name -> m (Wear 'Resolved a) Source #
Instances
Re-export Generically1 for compatibility.
newtype Generically1 (f :: k -> Type) (a :: k) where #
A type whose instances are defined generically, using the
Generic1 representation. Generically1 is a higher-kinded
version of Generically that uses Generic.
Generic instances can be derived for type constructors via
using Generically1 F-XDerivingVia.
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
import GHC.Generics (Generic)
data V4 a = V4 a a a a
deriving stock (Functor, Generic1)
deriving Applicative
via Generically1 V4
This corresponds to Applicative instances defined by pointwise
lifting:
instance Applicative V4 where
pure :: a -> V4 a
pure a = V4 a a a a
liftA2 :: (a -> b -> c) -> (V4 a -> V4 b -> V4 c)
liftA2 (·) (V4 a1 b1 c1 d1) (V4 a2 b2 c2 d2) =
V4 (a1 · a2) (b1 · b2) (c1 · c2) (d1 · d2)
Historically this required modifying the type class to include
generic method definitions (-XDefaultSignatures) and deriving it
with the anyclass strategy (-XDeriveAnyClass). Having a /via
type/ like Generically1 decouples the instance from the type
class.
Since: base-4.17.0.0
Constructors
| Generically1 :: forall {k} (f :: k -> Type) (a :: k). f a -> Generically1 f a |