mirror of
https://github.com/github/semantic.git
synced 2024-11-24 08:54:07 +03:00
Fix up pulling out go package name for import rendering
This commit is contained in:
Timothy Clem
parent
365a592c03
commit
724d8f38aa
@ -28,7 +28,7 @@ library
|
||||
, Analysis.Decorator
|
||||
, Analysis.Declaration
|
||||
, Analysis.IdentifierName
|
||||
, Analysis.ModuleDef
|
||||
, Analysis.PackageDef
|
||||
-- Semantic assignment
|
||||
, Assigning.Assignment
|
||||
, Assigning.Assignment.Table
|
||||
|
||||
@ -1,94 +0,0 @@
|
||||
{-# LANGUAGE ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
|
||||
module Analysis.ModuleDef
|
||||
( ModuleDef(..)
|
||||
, HasModuleDef
|
||||
, moduleDefAlgebra
|
||||
) where
|
||||
|
||||
import Prologue
|
||||
import Data.Blob
|
||||
import Data.Range
|
||||
import Data.Record
|
||||
import Data.Source as Source
|
||||
import Data.Span
|
||||
import qualified Data.Syntax.Declaration as Declaration
|
||||
import Data.Term
|
||||
import qualified Data.Text as T
|
||||
|
||||
newtype ModuleDef = ModuleDef { moduleDefIdentifier :: T.Text }
|
||||
deriving (Eq, Generic, Show)
|
||||
|
||||
-- | An r-algebra producing 'Just' a 'ModuleDef' for syntax nodes corresponding to high-level declarations, or 'Nothing' otherwise.
|
||||
--
|
||||
-- Customizing this for a given syntax type involves two steps:
|
||||
--
|
||||
-- 1. Defining a 'CustomHasModuleDef' instance for the type.
|
||||
-- 2. Adding the type to the 'ModuleDefStrategy' type family.
|
||||
--
|
||||
-- If you’re getting errors about missing a 'CustomHasModuleDef' instance for your syntax type, you probably forgot step 1.
|
||||
--
|
||||
-- If you’re getting 'Nothing' for your syntax node at runtime, you probably forgot step 2.
|
||||
moduleDefAlgebra :: (HasField fields Range, HasField fields Span, Foldable syntax, HasModuleDef syntax) => Blob -> RAlgebra (TermF syntax (Record fields)) (Term syntax (Record fields)) (Maybe ModuleDef)
|
||||
moduleDefAlgebra blob (In ann syntax) = toModuleDef blob ann syntax
|
||||
|
||||
|
||||
-- | Types for which we can produce a 'ModuleDef' in 'Maybe'. There is exactly one instance of this typeclass; adding customized 'ModuleDef's for a new type is done by defining an instance of 'CustomHasModuleDef' instead.
|
||||
--
|
||||
-- This typeclass employs the Advanced Overlap techniques designed by Oleg Kiselyov & Simon Peyton Jones: https://wiki.haskell.org/GHC/AdvancedOverlap.
|
||||
class HasModuleDef syntax where
|
||||
-- | Compute a 'ModuleDef' for a syntax type using its 'CustomHasModuleDef' instance, if any, or else falling back to the default definition (which simply returns 'Nothing').
|
||||
toModuleDef :: (Foldable whole, HasField fields Range, HasField fields Span) => Blob -> Record fields -> syntax (Term whole (Record fields), Maybe ModuleDef) -> Maybe ModuleDef
|
||||
|
||||
-- | Define 'toModuleDef' using the 'CustomHasModuleDef' instance for a type if there is one or else use the default definition.
|
||||
--
|
||||
-- This instance determines whether or not there is an instance for @syntax@ by looking it up in the 'ModuleDefStrategy' type family. Thus producing a 'ModuleDef' for a node requires both defining a 'CustomHasModuleDef' instance _and_ adding a definition for the type to the 'ModuleDefStrategy' type family to return 'Custom'.
|
||||
--
|
||||
-- Note that since 'ModuleDefStrategy' has a fallback case for its final entry, this instance will hold for all types of kind @* -> *@. Thus, this must be the only instance of 'HasModuleDef', as any other instance would be indistinguishable.
|
||||
instance (ModuleDefStrategy syntax ~ strategy, HasModuleDefWithStrategy strategy syntax) => HasModuleDef syntax where
|
||||
toModuleDef = toModuleDefWithStrategy (Proxy :: Proxy strategy)
|
||||
|
||||
|
||||
-- | Types for which we can produce a customized 'ModuleDef'. This returns in 'Maybe' so that some values can be opted out (e.g. anonymous functions).
|
||||
class CustomHasModuleDef syntax where
|
||||
-- | Produce a customized 'ModuleDef' for a given syntax node.
|
||||
customToModuleDef :: (Foldable whole, HasField fields Range, HasField fields Span) => Blob -> Record fields -> syntax (Term whole (Record fields), Maybe ModuleDef) -> Maybe ModuleDef
|
||||
|
||||
|
||||
instance CustomHasModuleDef Declaration.Module where
|
||||
customToModuleDef Blob{..} _ (Declaration.Module (Term (In fromAnn _), _) _)
|
||||
= Just $ ModuleDef (getSource fromAnn)
|
||||
where getSource = toText . flip Source.slice blobSource . getField
|
||||
|
||||
-- | Produce a 'ModuleDef' for 'Union's using the 'HasModuleDef' instance & therefore using a 'CustomHasModuleDef' instance when one exists & the type is listed in 'ModuleDefStrategy'.
|
||||
instance Apply HasModuleDef fs => CustomHasModuleDef (Union fs) where
|
||||
customToModuleDef blob ann = apply (Proxy :: Proxy HasModuleDef) (toModuleDef blob ann)
|
||||
|
||||
|
||||
-- | A strategy for defining a 'HasModuleDef' instance. Intended to be promoted to the kind level using @-XDataKinds@.
|
||||
data Strategy = Default | Custom
|
||||
|
||||
-- | Produce a 'ModuleDef' for a syntax node using either the 'Default' or 'Custom' strategy.
|
||||
--
|
||||
-- You should probably be using 'CustomHasModuleDef' instead of this class; and you should not define new instances of this class.
|
||||
class HasModuleDefWithStrategy (strategy :: Strategy) syntax where
|
||||
toModuleDefWithStrategy :: (Foldable whole, HasField fields Range, HasField fields Span) => proxy strategy -> Blob -> Record fields -> syntax (Term whole (Record fields), Maybe ModuleDef) -> Maybe ModuleDef
|
||||
|
||||
|
||||
-- | A predicate on syntax types selecting either the 'Custom' or 'Default' strategy.
|
||||
--
|
||||
-- Only entries for which we want to use the 'Custom' strategy should be listed, with the exception of the final entry which maps all other types onto the 'Default' strategy.
|
||||
--
|
||||
-- If you’re seeing errors about missing a 'CustomHasModuleDef' instance for a given type, you’ve probably listed it in here but not defined a 'CustomHasModuleDef' instance for it, or else you’ve listed the wrong type in here. Conversely, if your 'customHasModuleDef' method is never being called, you may have forgotten to list the type in here.
|
||||
type family ModuleDefStrategy syntax where
|
||||
ModuleDefStrategy Declaration.Module = 'Custom
|
||||
ModuleDefStrategy (Union fs) = 'Custom
|
||||
ModuleDefStrategy a = 'Default
|
||||
|
||||
|
||||
-- | The 'Default' strategy produces 'Nothing'.
|
||||
instance HasModuleDefWithStrategy 'Default syntax where
|
||||
toModuleDefWithStrategy _ _ _ _ = Nothing
|
||||
|
||||
-- | The 'Custom' strategy delegates the selection of the strategy to the 'CustomHasModuleDef' instance for the type.
|
||||
instance CustomHasModuleDef syntax => HasModuleDefWithStrategy 'Custom syntax where
|
||||
toModuleDefWithStrategy _ = customToModuleDef
|
||||
94
src/Analysis/PackageDef.hs
Normal file
94
src/Analysis/PackageDef.hs
Normal file
@ -0,0 +1,94 @@
|
||||
{-# LANGUAGE ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
|
||||
module Analysis.PackageDef
|
||||
( PackageDef(..)
|
||||
, HasPackageDef
|
||||
, packageDefAlgebra
|
||||
) where
|
||||
|
||||
import Prologue
|
||||
import Data.Blob
|
||||
import Data.Range
|
||||
import Data.Record
|
||||
import Data.Source as Source
|
||||
import Data.Span
|
||||
import qualified Language.Go.Syntax
|
||||
import Data.Term
|
||||
import qualified Data.Text as T
|
||||
|
||||
newtype PackageDef = PackageDef { moduleDefIdentifier :: T.Text }
|
||||
deriving (Eq, Generic, Show)
|
||||
|
||||
-- | An r-algebra producing 'Just' a 'PackageDef' for syntax nodes corresponding to high-level declarations, or 'Nothing' otherwise.
|
||||
--
|
||||
-- Customizing this for a given syntax type involves two steps:
|
||||
--
|
||||
-- 1. Defining a 'CustomHasPackageDef' instance for the type.
|
||||
-- 2. Adding the type to the 'PackageDefStrategy' type family.
|
||||
--
|
||||
-- If you’re getting errors about missing a 'CustomHasPackageDef' instance for your syntax type, you probably forgot step 1.
|
||||
--
|
||||
-- If you’re getting 'Nothing' for your syntax node at runtime, you probably forgot step 2.
|
||||
packageDefAlgebra :: (HasField fields Range, HasField fields Span, Foldable syntax, HasPackageDef syntax) => Blob -> RAlgebra (TermF syntax (Record fields)) (Term syntax (Record fields)) (Maybe PackageDef)
|
||||
packageDefAlgebra blob (In ann syntax) = toPackageDef blob ann syntax
|
||||
|
||||
|
||||
-- | Types for which we can produce a 'PackageDef' in 'Maybe'. There is exactly one instance of this typeclass; adding customized 'PackageDef's for a new type is done by defining an instance of 'CustomHasPackageDef' instead.
|
||||
--
|
||||
-- This typeclass employs the Advanced Overlap techniques designed by Oleg Kiselyov & Simon Peyton Jones: https://wiki.haskell.org/GHC/AdvancedOverlap.
|
||||
class HasPackageDef syntax where
|
||||
-- | Compute a 'PackageDef' for a syntax type using its 'CustomHasPackageDef' instance, if any, or else falling back to the default definition (which simply returns 'Nothing').
|
||||
toPackageDef :: (Foldable whole, HasField fields Range, HasField fields Span) => Blob -> Record fields -> syntax (Term whole (Record fields), Maybe PackageDef) -> Maybe PackageDef
|
||||
|
||||
-- | Define 'toPackageDef' using the 'CustomHasPackageDef' instance for a type if there is one or else use the default definition.
|
||||
--
|
||||
-- This instance determines whether or not there is an instance for @syntax@ by looking it up in the 'PackageDefStrategy' type family. Thus producing a 'PackageDef' for a node requires both defining a 'CustomHasPackageDef' instance _and_ adding a definition for the type to the 'PackageDefStrategy' type family to return 'Custom'.
|
||||
--
|
||||
-- Note that since 'PackageDefStrategy' has a fallback case for its final entry, this instance will hold for all types of kind @* -> *@. Thus, this must be the only instance of 'HasPackageDef', as any other instance would be indistinguishable.
|
||||
instance (PackageDefStrategy syntax ~ strategy, HasPackageDefWithStrategy strategy syntax) => HasPackageDef syntax where
|
||||
toPackageDef = toPackageDefWithStrategy (Proxy :: Proxy strategy)
|
||||
|
||||
|
||||
-- | Types for which we can produce a customized 'PackageDef'. This returns in 'Maybe' so that some values can be opted out (e.g. anonymous functions).
|
||||
class CustomHasPackageDef syntax where
|
||||
-- | Produce a customized 'PackageDef' for a given syntax node.
|
||||
customToPackageDef :: (Foldable whole, HasField fields Range, HasField fields Span) => Blob -> Record fields -> syntax (Term whole (Record fields), Maybe PackageDef) -> Maybe PackageDef
|
||||
|
||||
|
||||
instance CustomHasPackageDef Language.Go.Syntax.Package where
|
||||
customToPackageDef Blob{..} _ (Language.Go.Syntax.Package (Term (In fromAnn _), _) _)
|
||||
= Just $ PackageDef (getSource fromAnn)
|
||||
where getSource = toText . flip Source.slice blobSource . getField
|
||||
|
||||
-- | Produce a 'PackageDef' for 'Union's using the 'HasPackageDef' instance & therefore using a 'CustomHasPackageDef' instance when one exists & the type is listed in 'PackageDefStrategy'.
|
||||
instance Apply HasPackageDef fs => CustomHasPackageDef (Union fs) where
|
||||
customToPackageDef blob ann = apply (Proxy :: Proxy HasPackageDef) (toPackageDef blob ann)
|
||||
|
||||
|
||||
-- | A strategy for defining a 'HasPackageDef' instance. Intended to be promoted to the kind level using @-XDataKinds@.
|
||||
data Strategy = Default | Custom
|
||||
|
||||
-- | Produce a 'PackageDef' for a syntax node using either the 'Default' or 'Custom' strategy.
|
||||
--
|
||||
-- You should probably be using 'CustomHasPackageDef' instead of this class; and you should not define new instances of this class.
|
||||
class HasPackageDefWithStrategy (strategy :: Strategy) syntax where
|
||||
toPackageDefWithStrategy :: (Foldable whole, HasField fields Range, HasField fields Span) => proxy strategy -> Blob -> Record fields -> syntax (Term whole (Record fields), Maybe PackageDef) -> Maybe PackageDef
|
||||
|
||||
|
||||
-- | A predicate on syntax types selecting either the 'Custom' or 'Default' strategy.
|
||||
--
|
||||
-- Only entries for which we want to use the 'Custom' strategy should be listed, with the exception of the final entry which maps all other types onto the 'Default' strategy.
|
||||
--
|
||||
-- If you’re seeing errors about missing a 'CustomHasPackageDef' instance for a given type, you’ve probably listed it in here but not defined a 'CustomHasPackageDef' instance for it, or else you’ve listed the wrong type in here. Conversely, if your 'customHasPackageDef' method is never being called, you may have forgotten to list the type in here.
|
||||
type family PackageDefStrategy syntax where
|
||||
PackageDefStrategy Language.Go.Syntax.Package = 'Custom
|
||||
PackageDefStrategy (Union fs) = 'Custom
|
||||
PackageDefStrategy a = 'Default
|
||||
|
||||
|
||||
-- | The 'Default' strategy produces 'Nothing'.
|
||||
instance HasPackageDefWithStrategy 'Default syntax where
|
||||
toPackageDefWithStrategy _ _ _ _ = Nothing
|
||||
|
||||
-- | The 'Custom' strategy delegates the selection of the strategy to the 'CustomHasPackageDef' instance for the type.
|
||||
instance CustomHasPackageDef syntax => HasPackageDefWithStrategy 'Custom syntax where
|
||||
toPackageDefWithStrategy _ = customToPackageDef
|
||||
@ -6,7 +6,7 @@ module Rendering.Imports
|
||||
|
||||
import Prologue
|
||||
import Analysis.Declaration
|
||||
import Analysis.ModuleDef
|
||||
import Analysis.PackageDef
|
||||
import Data.Aeson
|
||||
import Data.Blob
|
||||
import Data.ByteString.Lazy (toStrict)
|
||||
@ -35,29 +35,29 @@ instance Output ImportSummary where
|
||||
instance ToJSON ImportSummary where
|
||||
toJSON (ImportSummary m) = object [ "modules" .= m ]
|
||||
|
||||
renderToImports :: (HasField fields (Maybe ModuleDef), HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => Blob -> Term f (Record fields) -> ImportSummary
|
||||
renderToImports :: (HasField fields (Maybe PackageDef), HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => Blob -> Term f (Record fields) -> ImportSummary
|
||||
renderToImports blob term = ImportSummary $ toMap (termToModule blob term)
|
||||
where
|
||||
toMap m@Module{..} = Map.singleton moduleName m
|
||||
termToModule :: (HasField fields (Maybe ModuleDef), HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => Blob -> Term f (Record fields) -> Module
|
||||
termToModule :: (HasField fields (Maybe PackageDef), HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => Blob -> Term f (Record fields) -> Module
|
||||
termToModule blob@Blob{..} term = makeModule detectModuleName blob declarations
|
||||
where
|
||||
declarations = termTableOfContentsBy declaration term
|
||||
defaultModuleName = T.pack (takeBaseName blobPath)
|
||||
detectModuleName = case termTableOfContentsBy moduleDef term of
|
||||
x:_ | Just ModuleDef{..} <- getModuleDef x -> moduleDefIdentifier
|
||||
x:_ | Just PackageDef{..} <- getPackageDef x -> moduleDefIdentifier
|
||||
_ -> defaultModuleName
|
||||
|
||||
makeModule :: (HasField fields Span, HasField fields (Maybe Declaration)) => T.Text -> Blob -> [Record fields] -> Module
|
||||
makeModule name Blob{..} ds = Module name [T.pack blobPath] (T.pack . show <$> blobLanguage) (mapMaybe importSummary ds) (mapMaybe (declarationSummary name) ds) (mapMaybe referenceSummary ds)
|
||||
|
||||
|
||||
getModuleDef :: HasField fields (Maybe ModuleDef) => Record fields -> Maybe ModuleDef
|
||||
getModuleDef = getField
|
||||
getPackageDef :: HasField fields (Maybe PackageDef) => Record fields -> Maybe PackageDef
|
||||
getPackageDef = getField
|
||||
|
||||
-- | Produce the annotations of nodes representing moduleDefs.
|
||||
moduleDef :: HasField fields (Maybe ModuleDef) => TermF f (Record fields) a -> Maybe (Record fields)
|
||||
moduleDef (In annotation _) = annotation <$ getModuleDef annotation
|
||||
moduleDef :: HasField fields (Maybe PackageDef) => TermF f (Record fields) a -> Maybe (Record fields)
|
||||
moduleDef (In annotation _) = annotation <$ getPackageDef annotation
|
||||
|
||||
declarationSummary :: (HasField fields (Maybe Declaration), HasField fields Span) => Text -> Record fields -> Maybe SymbolDeclaration
|
||||
declarationSummary module' record = case getDeclaration record of
|
||||
|
||||
@ -11,7 +11,7 @@ import Prologue
|
||||
import Analysis.ConstructorName (ConstructorName, constructorLabel)
|
||||
import Analysis.IdentifierName (IdentifierName, identifierLabel)
|
||||
import Analysis.Declaration (HasDeclaration, declarationAlgebra)
|
||||
import Analysis.ModuleDef (HasModuleDef, moduleDefAlgebra)
|
||||
import Analysis.PackageDef (HasPackageDef, packageDefAlgebra)
|
||||
import Data.Blob
|
||||
import Data.Diff
|
||||
import Data.JSON.Fields
|
||||
@ -44,12 +44,12 @@ parseBlobs renderer blobs = toOutput' <$> distributeFoldMap (parseBlob renderer)
|
||||
-- | A task to parse a 'Blob' and render the resulting 'Term'.
|
||||
parseBlob :: TermRenderer output -> Blob -> Task output
|
||||
parseBlob renderer blob@Blob{..}
|
||||
| Just (SomeParser parser) <- someParser (Proxy :: Proxy '[ConstructorName, HasModuleDef, HasDeclaration, IdentifierName, Foldable, Functor, ToJSONFields1]) <$> blobLanguage
|
||||
| Just (SomeParser parser) <- someParser (Proxy :: Proxy '[ConstructorName, HasPackageDef, HasDeclaration, IdentifierName, Foldable, Functor, ToJSONFields1]) <$> blobLanguage
|
||||
= parse parser blob >>= case renderer of
|
||||
JSONTermRenderer -> decorate constructorLabel >=> decorate identifierLabel >=> render (renderJSONTerm blob)
|
||||
SExpressionTermRenderer -> decorate constructorLabel . (Nil <$) >=> render renderSExpressionTerm
|
||||
TagsTermRenderer -> decorate (declarationAlgebra blob) >=> render (renderToTags blob)
|
||||
ImportsTermRenderer -> decorate (declarationAlgebra blob) >=> decorate (moduleDefAlgebra blob) >=> render (renderToImports blob)
|
||||
ImportsTermRenderer -> decorate (declarationAlgebra blob) >=> decorate (packageDefAlgebra blob) >=> render (renderToImports blob)
|
||||
SymbolsTermRenderer fields -> decorate (declarationAlgebra blob) >=> render (renderToSymbols fields blob)
|
||||
DOTTermRenderer -> render (renderDOTTerm blob)
|
||||
| otherwise = throwError (SomeException (NoLanguageForBlob blobPath))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user