diff --git a/src/Analysis/Declaration.hs b/src/Analysis/Declaration.hs index d5161b947..d1e2cd296 100644 --- a/src/Analysis/Declaration.hs +++ b/src/Analysis/Declaration.hs @@ -19,6 +19,7 @@ import Data.Semigroup (sconcat) import Data.Span import qualified Data.Syntax as Syntax import qualified Data.Syntax.Declaration as Declaration +import qualified Data.Syntax.Expression as Expression import Data.Term import qualified Data.Text as T import Data.Union @@ -31,6 +32,7 @@ data Declaration | ClassDeclaration { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Maybe Language } | ImportDeclaration { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Maybe Language } | FunctionDeclaration { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Maybe Language } + | CallReference { declarationIdentifier :: T.Text } | HeadingDeclaration { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Maybe Language, declarationLevel :: Int } | ErrorDeclaration { declarationIdentifier :: T.Text, declarationText :: T.Text, declarationLanguage :: Maybe Language } deriving (Eq, Generic, Show) @@ -123,6 +125,11 @@ instance CustomHasDeclaration Declaration.Import where = Just $ ImportDeclaration (getSource fromAnn) (getImportSource blob (In ann decl)) blobLanguage where getSource = toText . flip Source.slice blobSource . getField +instance CustomHasDeclaration Expression.Call where + customToDeclaration blob@Blob{..} ann decl@(Expression.Call _ (Term (In fromAnn _), _) _ _) + = Just $ CallReference (getSource fromAnn) + where getSource = toText . flip Source.slice blobSource . getField + -- | Produce a 'Declaration' for 'Union's using the 'HasDeclaration' instance & therefore using a 'CustomHasDeclaration' instance when one exists & the type is listed in 'DeclarationStrategy'. instance Apply HasDeclaration fs => CustomHasDeclaration (Union fs) where customToDeclaration blob ann = apply (Proxy :: Proxy HasDeclaration) (toDeclaration blob ann) @@ -148,6 +155,7 @@ type family DeclarationStrategy syntax where DeclarationStrategy Declaration.Function = 'Custom DeclarationStrategy Declaration.Import = 'Custom DeclarationStrategy Declaration.Method = 'Custom + DeclarationStrategy Expression.Call = 'Custom DeclarationStrategy Markdown.Heading = 'Custom DeclarationStrategy Syntax.Error = 'Custom DeclarationStrategy (Union fs) = 'Custom diff --git a/src/Rendering/Imports.hs b/src/Rendering/Imports.hs index c460d61fc..2c0898d6c 100644 --- a/src/Rendering/Imports.hs +++ b/src/Rendering/Imports.hs @@ -27,13 +27,16 @@ renderToImports :: (HasField fields (Maybe Declaration), HasField fields Span, F renderToImports Blob{..} term = [toJSON (termToC blobPath term)] where termToC :: (HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => FilePath -> Term f (Record fields) -> Module - termToC path term = let toc = termTableOfContentsBy declaration term in Module + termToC path term = Module { moduleName = T.pack (takeBaseName path) , modulePath = T.pack path , moduleLanguage = T.pack . show <$> blobLanguage - , moduleImports = mapMaybe importSummary toc - , moduleDeclarations = mapMaybe declarationSummary toc + , moduleImports = mapMaybe importSummary declarations + , moduleDeclarations = mapMaybe declarationSummary declarations + , moduleReferences = mapMaybe referenceSummary declarations } + where + declarations = termTableOfContentsBy declaration term declarationSummary :: (HasField fields (Maybe Declaration), HasField fields Span) => Record fields -> Maybe SymbolDeclaration declarationSummary record = case getDeclaration record of @@ -48,10 +51,12 @@ declarationSummary record = case getDeclaration record of importSummary :: (HasField fields (Maybe Declaration), HasField fields Span) => Record fields -> Maybe SymbolImport importSummary record = case getDeclaration record of - Just ImportDeclaration{..} -> Just SymbolImport - { symbolName = declarationIdentifier - , symbolSpan = getField record - } + Just ImportDeclaration{..} -> Just $ SymbolImport declarationIdentifier (getField record) + _ -> Nothing + +referenceSummary :: (HasField fields (Maybe Declaration), HasField fields Span) => Record fields -> Maybe SymbolReference +referenceSummary record = case getDeclaration record of + Just decl@CallReference{..} -> Just $ SymbolReference declarationIdentifier (toCategoryName decl) (getField record) _ -> Nothing data Module = Module @@ -60,7 +65,7 @@ data Module = Module , moduleLanguage :: Maybe T.Text , moduleImports :: [SymbolImport] , moduleDeclarations :: [SymbolDeclaration] - -- , moduleReferences :: [SymbolReferences] + , moduleReferences :: [SymbolReference] } deriving (Generic, Eq, Show) instance ToJSON Module where @@ -69,6 +74,7 @@ instance ToJSON Module where , "langauge" .= moduleLanguage , "imports" .= moduleImports , "declarations" .= moduleDeclarations + , "references" .= moduleReferences ] data SymbolDeclaration = SymbolDeclaration @@ -84,10 +90,21 @@ instance ToJSON SymbolDeclaration where ] data SymbolImport = SymbolImport - { symbolName :: T.Text - , symbolSpan :: Span + { importName :: T.Text + , importSpan :: Span } deriving (Generic, Eq, Show) instance ToJSON SymbolImport where - toJSON SymbolImport{..} = object [ "name" .= symbolName - , "span" .= symbolSpan ] + toJSON SymbolImport{..} = object [ "name" .= importName + , "span" .= importSpan ] + +data SymbolReference = SymbolReference + { referenceName :: T.Text + , referenceKind :: T.Text + , referenceSpan :: Span + } deriving (Generic, Eq, Show) + +instance ToJSON SymbolReference where + toJSON SymbolReference{..} = object [ "name" .= referenceName + , "kinds" .= referenceKind + , "span" .= referenceSpan ] diff --git a/src/Rendering/TOC.hs b/src/Rendering/TOC.hs index bb1d6163e..b9fe1737a 100644 --- a/src/Rendering/TOC.hs +++ b/src/Rendering/TOC.hs @@ -189,5 +189,6 @@ toCategoryName declaration = case declaration of ImportDeclaration{} -> "Import" FunctionDeclaration{} -> "Function" MethodDeclaration{} -> "Method" + CallReference{} -> "Call" HeadingDeclaration _ _ _ l -> "Heading " <> T.pack (show l) ErrorDeclaration{} -> "ParseError"