github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-30 10:27:45 +03:00
Code Issues Projects Releases Wiki Activity

Decorate the term with the identifier algebraically.

Browse Source
This commit is contained in:
Rob Rix 2017-04-27 16:57:47 -04:00
parent 4abace2490
commit 96d2ccf92e
2 changed files with 20 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/Renderer/JSON.hs
View File

@ -20,6 +20,7 @@ import Data.These
import Data.Vector as Vector hiding (toList)
import Diff
import Info
import Language.Ruby.Syntax (decoratorWithAlgebra, fToR)
import Prologue
import qualified Data.Map as Map
import qualified Data.Text as T
@ -224,15 +225,11 @@ jsonIndexParseTree = jsonParseTree' IndexFile combine
jsonParseTree' :: (ToJSON root, HasDefaultFields fields) => (FilePath -> a -> root) -> (ParseNode -> [a] -> a) -> Bool -> SourceBlob -> Term (Syntax Text) (Record fields) -> Value
jsonParseTree' constructor combine debug SourceBlob{..} term = toJSON $ constructor path (para algebra term')
where
term' = decorateTerm (if debug then termSourceTextDecorator source else const Nothing) term
term' = decorateTerm (if debug then termSourceTextDecorator source else const Nothing) (decoratorWithAlgebra (fToR maybeIdentifier) term)
algebra (annotation :< syntax) = combine (makeNode annotation (Prologue.fst <$> syntax)) (toList (Prologue.snd <$> syntax))
makeNode :: HasDefaultFields fields => Record (Maybe SourceText ': fields) -> Syntax Text (Term (Syntax Text) (Record (Maybe SourceText ': fields))) -> ParseNode
makeNode (sourceText :. record) syntax = ParseNode (getField record) (getField record) sourceText (getField record) (identifierFor syntax)
-- | Returns a Just identifier text if the given Syntax term contains an identifier (leaf) syntax. Otherwise returns Nothing.
identifierFor :: (HasField fields (Maybe SourceText), HasField fields Category, StringConv leaf Text) => Syntax leaf (Term (Syntax leaf) (Record fields)) -> Maybe Text
identifierFor = fmap toS . extractLeafValue . unwrap <=< maybeIdentifier
makeNode :: HasDefaultFields fields => Record (Maybe SourceText ': Maybe Text ': fields) -> Syntax Text (Term (Syntax Text) (Record (Maybe SourceText ': Maybe Text ': fields))) -> ParseNode
makeNode (sourceText :. record) _ = ParseNode (getField record) (getField record) sourceText (getField record) (getField record)
-- | Decorate a 'Term' using a function to compute the annotation values at every node.
decorateTerm :: (Functor f, HasDefaultFields fields) => TermDecorator f fields field -> Term f (Record fields) -> Term f (Record (field ': fields))

33
src/Syntax.hs
View File

@ -1,8 +1,6 @@
{-# LANGUAGE DeriveAnyClass #-}
module Syntax where
import Data.Record
import qualified Info
import Data.Aeson
import Data.Functor.Classes
import Data.Functor.Classes.Eq.Generic
@ -119,21 +117,22 @@ extractLeafValue syntax = case syntax of
Leaf a -> Just a
_ -> Nothing
maybeIdentifier :: HasField fields Info.Category => Syntax leaf (Cofree (Syntax leaf) (Record fields)) -> Maybe (Cofree (Syntax leaf) (Record fields))
maybeIdentifier syntax = case syntax of
Assignment f _ -> Just f
Class f _ _ -> Just f
Export f _ -> f
Function f _ _ -> Just f
FunctionCall f _ _ -> Just f
Import f _ -> Just f
Method _ f _ _ _ -> Just f
MethodCall _ f _ _ -> Just f
Module f _ -> Just f
OperatorAssignment f _ -> Just f
SubscriptAccess f _ -> Just f
TypeDecl f _ -> Just f
VarAssignment f _ -> find ((== Info.Identifier) . Info.category . extract) f
maybeIdentifier :: CofreeF (Syntax leaf) a (Maybe leaf) -> Maybe leaf
maybeIdentifier (_ :< syntax) = case syntax of
Leaf f -> Just f
Assignment f _ -> f
Class f _ _ -> f
Export f _ -> join f
Function f _ _ -> f
FunctionCall f _ _ -> f
Import f _ -> f
Method _ f _ _ _ -> f
MethodCall _ f _ _ -> f
Module f _ -> f
OperatorAssignment f _ -> f
SubscriptAccess f _ -> f
TypeDecl f _ -> f
VarAssignment f _ -> asum f
_ -> Nothing
-- Instances