module Language.Haskell.Tools.AST.SemaInfoTypes
(
NoSemanticInfo, ScopeInfo, NameInfo, CNameInfo, ModuleInfo, ImportInfo, ImplicitFieldInfo
, Scope
, exprScopedLocals, nameScopedLocals, nameIsDefined, nameInfo, ambiguousName, nameLocation
, implicitName, cnameScopedLocals, cnameIsDefined, cnameInfo, cnameFixity
, defModuleName, defIsBootModule, implicitNames, importedModule, availableNames, importedNames
, implicitFieldBindings
, mkNoSemanticInfo, mkScopeInfo, mkNameInfo, mkAmbiguousNameInfo, mkImplicitNameInfo, mkCNameInfo
, mkModuleInfo, mkImportInfo, mkImplicitFieldInfo
) where
import Name as GHC
import BasicTypes as GHC
import Id as GHC
import Module as GHC
import SrcLoc as GHC
import RdrName as GHC
import Outputable as GHC
import Data.Maybe
import Data.List
import Data.Data
import Control.Reference
type Scope = [[Name]]
data NoSemanticInfo = NoSemanticInfo
deriving (Eq, Data)
mkNoSemanticInfo :: NoSemanticInfo
mkNoSemanticInfo = NoSemanticInfo
data ScopeInfo = ScopeInfo { _exprScopedLocals :: Scope
}
deriving (Eq, Data)
mkScopeInfo :: Scope -> ScopeInfo
mkScopeInfo = ScopeInfo
data NameInfo n = NameInfo { _nameScopedLocals :: Scope
, _nameIsDefined :: Bool
, _nameInfo :: n
}
| AmbiguousNameInfo { _nameScopedLocals :: Scope
, _nameIsDefined :: Bool
, _ambiguousName :: RdrName
, _nameLocation :: SrcSpan
}
| ImplicitNameInfo { _nameScopedLocals :: Scope
, _nameIsDefined :: Bool
, _implicitName :: String
, _nameLocation :: SrcSpan
}
deriving (Eq, Data)
mkNameInfo :: Scope -> Bool -> n -> NameInfo n
mkNameInfo = NameInfo
mkAmbiguousNameInfo :: Scope -> Bool -> RdrName -> SrcSpan -> NameInfo n
mkAmbiguousNameInfo = AmbiguousNameInfo
mkImplicitNameInfo :: Scope -> Bool -> String -> SrcSpan -> NameInfo n
mkImplicitNameInfo = ImplicitNameInfo
data CNameInfo = CNameInfo { _cnameScopedLocals :: Scope
, _cnameIsDefined :: Bool
, _cnameInfo :: Id
, _cnameFixity :: Maybe GHC.Fixity
}
deriving (Eq, Data)
mkCNameInfo :: Scope -> Bool -> Id -> Maybe GHC.Fixity -> CNameInfo
mkCNameInfo = CNameInfo
data ModuleInfo n = ModuleInfo { _defModuleName :: GHC.Module
, _defIsBootModule :: Bool
, _implicitNames :: [n]
}
deriving (Eq, Data)
mkModuleInfo :: GHC.Module -> Bool -> [n] -> ModuleInfo n
mkModuleInfo = ModuleInfo
data ImportInfo n = ImportInfo { _importedModule :: GHC.Module
, _availableNames :: [n]
, _importedNames :: [n]
}
deriving (Eq, Data)
mkImportInfo :: GHC.Module -> [n] -> [n] -> ImportInfo n
mkImportInfo = ImportInfo
data ImplicitFieldInfo = ImplicitFieldInfo { _implicitFieldBindings :: [(Name, Name)]
}
deriving (Eq, Data)
mkImplicitFieldInfo :: [(Name, Name)] -> ImplicitFieldInfo
mkImplicitFieldInfo = ImplicitFieldInfo
instance Show ScopeInfo where
show (ScopeInfo locals) = "(ScopeInfo " ++ showSDocUnsafe (ppr locals) ++ ")"
instance Outputable n => Show (NameInfo n) where
show (NameInfo locals defined nameInfo) = "(NameInfo " ++ showSDocUnsafe (ppr locals) ++ " " ++ show defined ++ " " ++ showSDocUnsafe (ppr nameInfo) ++ ")"
show (AmbiguousNameInfo locals defined nameInfo span) = "(AmbiguousNameInfo " ++ showSDocUnsafe (ppr locals) ++ " " ++ show defined ++ " " ++ showSDocUnsafe (ppr nameInfo) ++ " " ++ show span ++ ")"
show (ImplicitNameInfo locals defined nameInfo span) = "(ImplicitNameInfo " ++ showSDocUnsafe (ppr locals) ++ " " ++ show defined ++ " " ++ showSDocUnsafe (ppr nameInfo) ++ " " ++ show span ++ ")"
instance Show CNameInfo where
show (CNameInfo locals defined nameInfo fixity) = "(CNameInfo " ++ showSDocUnsafe (ppr locals) ++ " " ++ show defined ++ " " ++ showSDocUnsafe (ppr nameInfo) ++ showSDocUnsafe (ppr fixity) ++ ")"
instance Outputable n => Show (ModuleInfo n) where
show (ModuleInfo mod isboot imp) = "(ModuleInfo " ++ showSDocUnsafe (ppr mod) ++ " " ++ show isboot ++ " " ++ showSDocUnsafe (ppr imp) ++ ")"
instance Outputable n => Show (ImportInfo n) where
show (ImportInfo mod avail imported) = "(ImportInfo " ++ showSDocUnsafe (ppr mod) ++ " " ++ showSDocUnsafe (ppr avail) ++ " " ++ showSDocUnsafe (ppr imported) ++ ")"
instance Show ImplicitFieldInfo where
show (ImplicitFieldInfo bnds) = "(ImplicitFieldInfo [" ++ concat (intersperse "," (map (\(from,to) -> showSDocUnsafe (ppr from) ++ "->" ++ showSDocUnsafe (ppr to)) bnds)) ++ "])"
instance Show NoSemanticInfo where
show NoSemanticInfo = "NoSemanticInfo"
makeReferences ''NoSemanticInfo
makeReferences ''ScopeInfo
makeReferences ''NameInfo
makeReferences ''CNameInfo
makeReferences ''ModuleInfo
makeReferences ''ImportInfo
makeReferences ''ImplicitFieldInfo
instance Functor NameInfo where
fmap f = nameInfo .- f
instance Functor ModuleInfo where
fmap f = implicitNames .- map f
instance Functor ImportInfo where
fmap f (ImportInfo mod avail imps) = ImportInfo mod (map f avail) (map f imps)
instance Foldable NameInfo where
foldMap f si = maybe mempty f (si ^? nameInfo)
instance Foldable ModuleInfo where
foldMap f si = foldMap f (si ^. implicitNames)
instance Foldable ImportInfo where
foldMap f si = foldMap f ((si ^. availableNames) ++ (si ^. importedNames))
instance Traversable NameInfo where
traverse f (NameInfo locals defined nameInfo) = NameInfo locals defined <$> f nameInfo
traverse f (AmbiguousNameInfo locals defined nameInfo span) = pure $ AmbiguousNameInfo locals defined nameInfo span
traverse f (ImplicitNameInfo locals defined nameInfo span) = pure $ ImplicitNameInfo locals defined nameInfo span
instance Traversable ModuleInfo where
traverse f (ModuleInfo mod isboot imp) = ModuleInfo mod isboot <$> traverse f imp
instance Traversable ImportInfo where
traverse f (ImportInfo mod avail imps) = ImportInfo mod <$> traverse f avail <*> traverse f imps