module Language.Haskell.Tools.AST.SemaInfoClasses (module Language.Haskell.Tools.AST.SemaInfoClasses, UsageSpec(..)) where
import GHC
import Id as GHC (Id, idName)
import Control.Reference ((^?), (^.), (&))
import Language.Haskell.Tools.AST.Ann as AST
import Language.Haskell.Tools.AST.Representation.Exprs as AST (UFieldWildcard, UExpr)
import Language.Haskell.Tools.AST.Representation.Modules as AST (UImportDecl, UModule)
import Language.Haskell.Tools.AST.Representation.Names as AST (UQualifiedName)
import Language.Haskell.Tools.AST.SemaInfoTypes as AST
type HasNameInfo dom = (Domain dom, HasNameInfo' (SemanticInfo dom UQualifiedName))
class HasNameInfo' si where
semanticsName :: si -> Maybe GHC.Name
instance HasNameInfo' (NameInfo GHC.Name) where
semanticsName = (^? nameInfo)
instance HasNameInfo' CNameInfo where
semanticsName = fmap idName . (^? cnameInfo)
instance HasNameInfo dom => HasNameInfo' (Ann UQualifiedName dom st) where
semanticsName = semanticsName . (^. annotation&semanticInfo)
type HasIdInfo dom = (Domain dom, HasIdInfo' (SemanticInfo dom UQualifiedName))
class HasNameInfo' si => HasIdInfo' si where
semanticsId :: si -> Id
instance HasIdInfo' CNameInfo where
semanticsId = (^. cnameInfo)
instance HasIdInfo dom => HasIdInfo' (Ann UQualifiedName dom st) where
semanticsId = semanticsId . (^. annotation&semanticInfo)
type HasFixityInfo dom = (Domain dom, HasFixityInfo' (SemanticInfo dom UQualifiedName))
class HasFixityInfo' si where
semanticsFixity :: si -> Maybe GHC.Fixity
instance HasFixityInfo' CNameInfo where
semanticsFixity = (^. cnameFixity)
instance HasFixityInfo dom => HasFixityInfo' (Ann UQualifiedName dom st) where
semanticsFixity = semanticsFixity . (^. annotation&semanticInfo)
type HasScopeInfo dom = (Domain dom, HasScopeInfo' (SemanticInfo dom UQualifiedName), HasScopeInfo' (SemanticInfo dom UExpr))
class HasScopeInfo' si where
semanticsScope :: si -> Scope
instance HasScopeInfo' (NameInfo n) where
semanticsScope = (^. nameScopedLocals)
instance HasScopeInfo' CNameInfo where
semanticsScope = (^. cnameScopedLocals)
instance HasScopeInfo' ScopeInfo where
semanticsScope = (^. exprScopedLocals)
instance HasScopeInfo dom => HasScopeInfo' (Ann UExpr dom st) where
semanticsScope = semanticsScope . (^. annotation&semanticInfo)
instance HasScopeInfo dom => HasScopeInfo' (Ann UQualifiedName dom st) where
semanticsScope = semanticsScope . (^. annotation&semanticInfo)
type HasDefiningInfo dom = (Domain dom, HasDefiningInfo' (SemanticInfo dom UQualifiedName))
class HasDefiningInfo' si where
semanticsDefining :: si -> Bool
instance HasDefiningInfo' (NameInfo n) where
semanticsDefining = (^. nameIsDefined)
instance HasDefiningInfo' CNameInfo where
semanticsDefining = (^. cnameIsDefined)
instance HasDefiningInfo dom => HasDefiningInfo' (Ann UQualifiedName dom st) where
semanticsDefining = semanticsDefining . (^. annotation&semanticInfo)
class HasSourceInfoInSema' si where
semanticsSourceInfo :: si -> Maybe SrcSpan
instance HasSourceInfoInSema' (NameInfo n) where
semanticsSourceInfo = (^? nameLocation)
type HasModuleInfo dom = (Domain dom, HasModuleInfo' (SemanticInfo dom AST.UModule))
class HasModuleInfo' si where
semanticsModule :: si -> GHC.Module
semanticsDynFlags :: si -> GHC.DynFlags
isBootModule :: si -> Bool
semanticsImplicitImports :: si -> [GHC.Name]
semanticsPrelOrphanInsts :: si -> [ClsInst]
semanticsPrelFamInsts :: si -> [FamInst]
instance HasModuleInfo' (AST.ModuleInfo GHC.Name) where
semanticsModule = (^. defModuleName)
semanticsDynFlags = (^. defDynFlags)
isBootModule = (^. defIsBootModule)
semanticsImplicitImports = (^. implicitNames)
semanticsPrelOrphanInsts = (^. prelOrphanInsts)
semanticsPrelFamInsts = (^. prelFamInsts)
instance HasModuleInfo' (AST.ModuleInfo GHC.Id) where
semanticsModule = (^. defModuleName)
semanticsDynFlags = (^. defDynFlags)
isBootModule = (^. defIsBootModule)
semanticsImplicitImports = map idName . (^. implicitNames)
semanticsPrelOrphanInsts = (^. prelOrphanInsts)
semanticsPrelFamInsts = (^. prelFamInsts)
instance HasModuleInfo dom => HasModuleInfo' (Ann UModule dom st) where
semanticsModule = semanticsModule . (^. annotation&semanticInfo)
semanticsDynFlags = semanticsDynFlags . (^. annotation&semanticInfo)
isBootModule = isBootModule . (^. annotation&semanticInfo)
semanticsImplicitImports = semanticsImplicitImports . (^. annotation&semanticInfo)
semanticsPrelOrphanInsts = semanticsPrelOrphanInsts . (^. annotation&semanticInfo)
semanticsPrelFamInsts = semanticsPrelFamInsts . (^. annotation&semanticInfo)
type HasImportInfo dom = (Domain dom, HasImportInfo' (SemanticInfo dom AST.UImportDecl))
class HasImportInfo' si where
semanticsImportedModule :: si -> GHC.Module
semanticsAvailable :: si -> [GHC.Name]
semanticsImported :: si -> [GHC.Name]
semanticsOrphanInsts :: si -> [ClsInst]
semanticsFamInsts :: si -> [FamInst]
instance HasImportInfo' (AST.ImportInfo GHC.Name) where
semanticsImportedModule = (^. importedModule)
semanticsAvailable = (^. availableNames)
semanticsImported = (^. importedNames)
semanticsOrphanInsts = (^. importedOrphanInsts)
semanticsFamInsts = (^. importedFamInsts)
instance HasImportInfo' (AST.ImportInfo GHC.Id) where
semanticsImportedModule = (^. importedModule)
semanticsAvailable = map idName . (^. availableNames)
semanticsImported = map idName . (^. importedNames)
semanticsOrphanInsts = (^. importedOrphanInsts)
semanticsFamInsts = (^. importedFamInsts)
instance HasImportInfo dom => HasImportInfo' (Ann UImportDecl dom st) where
semanticsImportedModule = semanticsImportedModule . (^. annotation&semanticInfo)
semanticsAvailable = semanticsAvailable . (^. annotation&semanticInfo)
semanticsImported = semanticsImported . (^. annotation&semanticInfo)
semanticsOrphanInsts = semanticsOrphanInsts . (^. annotation&semanticInfo)
semanticsFamInsts = semanticsFamInsts . (^. annotation&semanticInfo)
type HasImplicitFieldsInfo dom = (Domain dom, HasImplicitFieldsInfo' (SemanticInfo dom AST.UFieldWildcard))
class HasImplicitFieldsInfo' si where
semanticsImplicitFlds :: si -> [(GHC.Name, GHC.Name)]
instance HasImplicitFieldsInfo' ImplicitFieldInfo where
semanticsImplicitFlds = (^. implicitFieldBindings)
instance HasImplicitFieldsInfo dom => HasImplicitFieldsInfo' (Ann UFieldWildcard dom st) where
semanticsImplicitFlds = semanticsImplicitFlds . (^. annotation&semanticInfo)
type HasNoSemanticInfo dom si = SemanticInfo dom si ~ NoSemanticInfo