mirror of
https://github.com/github/semantic.git
synced 2024-12-25 07:55:12 +03:00
Port everything over to PHP.Term.
This commit is contained in:
parent
05e372d772
commit
af85945d03
@ -203,6 +203,7 @@ library
|
||||
, Language.TypeScript.Term
|
||||
, Language.PHP.Assignment
|
||||
, Language.PHP.Syntax
|
||||
, Language.PHP.Term
|
||||
, Language.Python.Assignment
|
||||
, Language.Python.Syntax
|
||||
, Numeric.Exts
|
||||
|
@ -18,6 +18,7 @@ import qualified Language.Go.Syntax as Go
|
||||
import qualified Language.Go.Type as Go
|
||||
import qualified Language.Markdown.Syntax as Markdown
|
||||
import qualified Language.PHP.Syntax as PHP
|
||||
import qualified Language.PHP.Term as PHP
|
||||
import qualified Language.Python.Syntax as Python
|
||||
import qualified Language.Ruby.Syntax as Ruby
|
||||
import qualified Language.TSX.Syntax as TSX
|
||||
@ -27,6 +28,7 @@ import qualified Language.TypeScript.Term as TypeScript
|
||||
import Data.Quieterm
|
||||
|
||||
deriving instance AccessControls1 syntax => AccessControls (Term syntax ann)
|
||||
deriving instance AccessControls (PHP.Term ann)
|
||||
deriving instance AccessControls (TSX.Term ann)
|
||||
deriving instance AccessControls (TypeScript.Term ann)
|
||||
|
||||
|
@ -2,9 +2,9 @@
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-} -- FIXME
|
||||
module Language.PHP.Assignment
|
||||
( assignment
|
||||
, Syntax
|
||||
, PHP.Syntax
|
||||
, Grammar
|
||||
, Term
|
||||
, PHP.Term
|
||||
) where
|
||||
|
||||
import Prologue
|
||||
@ -34,140 +34,15 @@ import qualified Data.Syntax.Statement as Statement
|
||||
import qualified Data.Syntax.Type as Type
|
||||
import qualified Data.Term as Term
|
||||
import qualified Language.PHP.Syntax as Syntax
|
||||
import qualified Language.PHP.Term as PHP
|
||||
import TreeSitter.PHP as Grammar
|
||||
|
||||
type Syntax = '[
|
||||
Comment.Comment
|
||||
, Declaration.Class
|
||||
, Declaration.Function
|
||||
, Declaration.Method
|
||||
, Declaration.VariableDeclaration
|
||||
, Expression.Plus
|
||||
, Expression.Minus
|
||||
, Expression.Times
|
||||
, Expression.DividedBy
|
||||
, Expression.Modulo
|
||||
, Expression.Power
|
||||
, Expression.Negate
|
||||
, Expression.FloorDivision
|
||||
, Expression.BAnd
|
||||
, Expression.BOr
|
||||
, Expression.BXOr
|
||||
, Expression.LShift
|
||||
, Expression.RShift
|
||||
, Expression.And
|
||||
, Expression.Not
|
||||
, Expression.Or
|
||||
, Expression.XOr
|
||||
, Expression.Call
|
||||
, Expression.Cast
|
||||
, Expression.LessThan
|
||||
, Expression.LessThanEqual
|
||||
, Expression.GreaterThan
|
||||
, Expression.GreaterThanEqual
|
||||
, Expression.Equal
|
||||
, Expression.StrictEqual
|
||||
, Expression.Comparison
|
||||
, Expression.InstanceOf
|
||||
, Expression.MemberAccess
|
||||
, Expression.New
|
||||
, Expression.SequenceExpression
|
||||
, Expression.Subscript
|
||||
, Expression.Member
|
||||
, Literal.Array
|
||||
, Literal.Float
|
||||
, Literal.Integer
|
||||
, Literal.KeyValue
|
||||
, Literal.TextElement
|
||||
, Statement.Assignment
|
||||
, Statement.Break
|
||||
, Statement.Catch
|
||||
, Statement.Continue
|
||||
, Statement.DoWhile
|
||||
, Statement.Else
|
||||
, Statement.Finally
|
||||
, Statement.For
|
||||
, Statement.ForEach
|
||||
, Statement.Goto
|
||||
, Statement.If
|
||||
, Statement.Match
|
||||
, Statement.Pattern
|
||||
, Statement.Return
|
||||
, Statement.Statements
|
||||
, Statement.Throw
|
||||
, Statement.Try
|
||||
, Statement.While
|
||||
, Statement.Yield
|
||||
, Syntax.AliasAs
|
||||
, Syntax.ArrayElement
|
||||
, Syntax.BaseTypeDeclaration
|
||||
, Syntax.CastType
|
||||
, Syntax.ClassBaseClause
|
||||
, Syntax.ClassConstDeclaration
|
||||
, Syntax.ClassInterfaceClause
|
||||
, Syntax.ClassModifier
|
||||
, Syntax.Clone
|
||||
, Syntax.ConstDeclaration
|
||||
, Syntax.ConstructorDeclaration
|
||||
, Syntax.Context
|
||||
, Syntax.Declare
|
||||
, Syntax.DeclareDirective
|
||||
, Syntax.DestructorDeclaration
|
||||
, Syntax.Echo
|
||||
, Syntax.Empty
|
||||
, Syntax.EmptyIntrinsic
|
||||
, Syntax.Error
|
||||
, Syntax.ErrorControl
|
||||
, Syntax.EvalIntrinsic
|
||||
, Syntax.ExitIntrinsic
|
||||
, Syntax.GlobalDeclaration
|
||||
, Syntax.Identifier
|
||||
, Syntax.Include
|
||||
, Syntax.IncludeOnce
|
||||
, Syntax.InsteadOf
|
||||
, Syntax.InterfaceBaseClause
|
||||
, Syntax.InterfaceDeclaration
|
||||
, Syntax.IssetIntrinsic
|
||||
, Syntax.LabeledStatement
|
||||
, Syntax.Namespace
|
||||
, Syntax.NamespaceAliasingClause
|
||||
, Syntax.NamespaceName
|
||||
, Syntax.NamespaceUseClause
|
||||
, Syntax.NamespaceUseDeclaration
|
||||
, Syntax.NamespaceUseGroupClause
|
||||
, Syntax.NewVariable
|
||||
, Syntax.PrintIntrinsic
|
||||
, Syntax.PropertyDeclaration
|
||||
, Syntax.PropertyModifier
|
||||
, Syntax.QualifiedName
|
||||
, Syntax.RelativeScope
|
||||
, Syntax.Require
|
||||
, Syntax.RequireOnce
|
||||
, Syntax.ReturnType
|
||||
, Syntax.ScalarType
|
||||
, Syntax.ShellCommand
|
||||
, Syntax.Concat
|
||||
, Syntax.SimpleVariable
|
||||
, Syntax.Static
|
||||
, Syntax.Text
|
||||
, Syntax.TraitDeclaration
|
||||
, Syntax.TraitUseClause
|
||||
, Syntax.TraitUseSpecification
|
||||
, Syntax.TypeDeclaration
|
||||
, Syntax.Unset
|
||||
, Syntax.Update
|
||||
, Syntax.UseClause
|
||||
, Syntax.VariableName
|
||||
, Type.Annotation
|
||||
, []
|
||||
]
|
||||
|
||||
type Term = Term.Term (Sum Syntax)
|
||||
type Term = Term.Term (Sum PHP.Syntax)
|
||||
type Assignment = Assignment.Assignment [] Grammar
|
||||
|
||||
-- | Assignment from AST in PHP's grammar onto a program in PHP's syntax.
|
||||
assignment :: Assignment (Term Loc)
|
||||
assignment = handleError $ makeTerm <$> symbol Program <*> children (Statement.Statements <$> (bookend <$> (text <|> emptyTerm) <*> manyTerm statement <*> (text <|> emptyTerm))) <|> parseError
|
||||
assignment :: Assignment (PHP.Term Loc)
|
||||
assignment = fmap PHP.Term . handleError $ makeTerm <$> symbol Program <*> children (Statement.Statements <$> (bookend <$> (text <|> emptyTerm) <*> manyTerm statement <*> (text <|> emptyTerm))) <|> parseError
|
||||
|
||||
text :: Assignment (Term Loc)
|
||||
text = makeTerm <$> symbol Text <*> (Syntax.Text <$> source)
|
||||
@ -811,6 +686,6 @@ someTerm' = NonEmpty.some1 . commentedTerm
|
||||
-- | Match infix terms separated by any of a list of operators, assigning any comments following each operand.
|
||||
infixTerm :: Assignment (Term Loc)
|
||||
-> Assignment (Term Loc)
|
||||
-> [Assignment (Term Loc -> Term Loc -> Sum Syntax (Term Loc))]
|
||||
-> Assignment (Sum Syntax (Term Loc))
|
||||
-> [Assignment (Term Loc -> Term Loc -> Sum PHP.Syntax (Term Loc))]
|
||||
-> Assignment (Sum PHP.Syntax (Term Loc))
|
||||
infixTerm = infixContext (comment <|> textInterpolation)
|
||||
|
173
src/Language/PHP/Term.hs
Normal file
173
src/Language/PHP/Term.hs
Normal file
@ -0,0 +1,173 @@
|
||||
{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TypeFamilies #-}
|
||||
module Language.PHP.Term
|
||||
( Syntax
|
||||
, Term(..)
|
||||
, Diff(..)
|
||||
) where
|
||||
|
||||
import Control.Lens.Lens
|
||||
import Data.Abstract.Declarations
|
||||
import Data.Abstract.FreeVariables
|
||||
import Data.Bifoldable
|
||||
import Data.Bifunctor
|
||||
import qualified Data.Diff as Diff
|
||||
import Data.Functor.Foldable
|
||||
import Data.Graph.ControlFlowVertex (VertexDeclaration)
|
||||
import Data.Sum (Sum)
|
||||
import qualified Data.Syntax as Syntax
|
||||
import qualified Data.Syntax.Comment as Comment
|
||||
import qualified Data.Syntax.Declaration as Declaration
|
||||
import qualified Data.Syntax.Expression as Expression
|
||||
import qualified Data.Syntax.Literal as Literal
|
||||
import qualified Data.Syntax.Statement as Statement
|
||||
import qualified Data.Syntax.Type as Type
|
||||
import qualified Data.Term as Term
|
||||
import Diffing.Interpreter
|
||||
import qualified Language.PHP.Syntax as Syntax
|
||||
import Source.Span
|
||||
|
||||
type Syntax =
|
||||
[ Comment.Comment
|
||||
, Declaration.Class
|
||||
, Declaration.Function
|
||||
, Declaration.Method
|
||||
, Declaration.VariableDeclaration
|
||||
, Expression.Plus
|
||||
, Expression.Minus
|
||||
, Expression.Times
|
||||
, Expression.DividedBy
|
||||
, Expression.Modulo
|
||||
, Expression.Power
|
||||
, Expression.Negate
|
||||
, Expression.FloorDivision
|
||||
, Expression.BAnd
|
||||
, Expression.BOr
|
||||
, Expression.BXOr
|
||||
, Expression.LShift
|
||||
, Expression.RShift
|
||||
, Expression.And
|
||||
, Expression.Not
|
||||
, Expression.Or
|
||||
, Expression.XOr
|
||||
, Expression.Call
|
||||
, Expression.Cast
|
||||
, Expression.LessThan
|
||||
, Expression.LessThanEqual
|
||||
, Expression.GreaterThan
|
||||
, Expression.GreaterThanEqual
|
||||
, Expression.Equal
|
||||
, Expression.StrictEqual
|
||||
, Expression.Comparison
|
||||
, Expression.InstanceOf
|
||||
, Expression.MemberAccess
|
||||
, Expression.New
|
||||
, Expression.SequenceExpression
|
||||
, Expression.Subscript
|
||||
, Expression.Member
|
||||
, Literal.Array
|
||||
, Literal.Float
|
||||
, Literal.Integer
|
||||
, Literal.KeyValue
|
||||
, Literal.TextElement
|
||||
, Statement.Assignment
|
||||
, Statement.Break
|
||||
, Statement.Catch
|
||||
, Statement.Continue
|
||||
, Statement.DoWhile
|
||||
, Statement.Else
|
||||
, Statement.Finally
|
||||
, Statement.For
|
||||
, Statement.ForEach
|
||||
, Statement.Goto
|
||||
, Statement.If
|
||||
, Statement.Match
|
||||
, Statement.Pattern
|
||||
, Statement.Return
|
||||
, Statement.Statements
|
||||
, Statement.Throw
|
||||
, Statement.Try
|
||||
, Statement.While
|
||||
, Statement.Yield
|
||||
, Syntax.AliasAs
|
||||
, Syntax.ArrayElement
|
||||
, Syntax.BaseTypeDeclaration
|
||||
, Syntax.CastType
|
||||
, Syntax.ClassBaseClause
|
||||
, Syntax.ClassConstDeclaration
|
||||
, Syntax.ClassInterfaceClause
|
||||
, Syntax.ClassModifier
|
||||
, Syntax.Clone
|
||||
, Syntax.ConstDeclaration
|
||||
, Syntax.ConstructorDeclaration
|
||||
, Syntax.Context
|
||||
, Syntax.Declare
|
||||
, Syntax.DeclareDirective
|
||||
, Syntax.DestructorDeclaration
|
||||
, Syntax.Echo
|
||||
, Syntax.Empty
|
||||
, Syntax.EmptyIntrinsic
|
||||
, Syntax.Error
|
||||
, Syntax.ErrorControl
|
||||
, Syntax.EvalIntrinsic
|
||||
, Syntax.ExitIntrinsic
|
||||
, Syntax.GlobalDeclaration
|
||||
, Syntax.Identifier
|
||||
, Syntax.Include
|
||||
, Syntax.IncludeOnce
|
||||
, Syntax.InsteadOf
|
||||
, Syntax.InterfaceBaseClause
|
||||
, Syntax.InterfaceDeclaration
|
||||
, Syntax.IssetIntrinsic
|
||||
, Syntax.LabeledStatement
|
||||
, Syntax.Namespace
|
||||
, Syntax.NamespaceAliasingClause
|
||||
, Syntax.NamespaceName
|
||||
, Syntax.NamespaceUseClause
|
||||
, Syntax.NamespaceUseDeclaration
|
||||
, Syntax.NamespaceUseGroupClause
|
||||
, Syntax.NewVariable
|
||||
, Syntax.PrintIntrinsic
|
||||
, Syntax.PropertyDeclaration
|
||||
, Syntax.PropertyModifier
|
||||
, Syntax.QualifiedName
|
||||
, Syntax.RelativeScope
|
||||
, Syntax.Require
|
||||
, Syntax.RequireOnce
|
||||
, Syntax.ReturnType
|
||||
, Syntax.ScalarType
|
||||
, Syntax.ShellCommand
|
||||
, Syntax.Concat
|
||||
, Syntax.SimpleVariable
|
||||
, Syntax.Static
|
||||
, Syntax.Text
|
||||
, Syntax.TraitDeclaration
|
||||
, Syntax.TraitUseClause
|
||||
, Syntax.TraitUseSpecification
|
||||
, Syntax.TypeDeclaration
|
||||
, Syntax.Unset
|
||||
, Syntax.Update
|
||||
, Syntax.UseClause
|
||||
, Syntax.VariableName
|
||||
, Type.Annotation
|
||||
, []
|
||||
]
|
||||
|
||||
|
||||
newtype Term ann = Term { getTerm :: Term.Term (Sum Syntax) ann }
|
||||
deriving (Eq, Declarations, Foldable, FreeVariables, Functor, Syntax.HasErrors, Ord, Show, Traversable, VertexDeclaration)
|
||||
|
||||
newtype Diff ann1 ann2 = Diff { getDiff :: Diff.Diff (Sum Syntax) ann1 ann2 }
|
||||
deriving (Bifoldable, Bifunctor)
|
||||
|
||||
instance DiffTerms Term where
|
||||
type DiffFor Term = Diff
|
||||
diffTermPair = Diff . diffTermPair . bimap getTerm getTerm
|
||||
|
||||
type instance Base (Term ann) = Term.TermF (Sum Syntax) ann
|
||||
|
||||
instance Recursive (Term ann) where
|
||||
project = fmap Term . project . getTerm
|
||||
|
||||
instance HasSpan ann => HasSpan (Term ann) where
|
||||
span_ = inner.span_ where inner = lens getTerm (\t i -> t { getTerm = i })
|
||||
{-# INLINE span_ #-}
|
@ -30,6 +30,7 @@ import Data.Term
|
||||
import qualified Data.Text as T
|
||||
import Diffing.Algorithm (Diffable)
|
||||
import Diffing.Interpreter (DiffTerms(..))
|
||||
import qualified Language.PHP.Term as PHP
|
||||
import qualified Language.TSX.Term as TSX
|
||||
import qualified Language.TypeScript.Term as TypeScript
|
||||
import Parsing.Parser
|
||||
@ -100,6 +101,7 @@ class DiffTerms term => DOTGraphDiff term where
|
||||
instance (ConstructorName syntax, Diffable syntax, Eq1 syntax, Hashable1 syntax, Traversable syntax) => DOTGraphDiff (Term syntax) where
|
||||
dotGraphDiff = serialize (DOT (diffStyle "diffs")) . renderTreeGraph
|
||||
|
||||
deriving instance DOTGraphDiff PHP.Term
|
||||
deriving instance DOTGraphDiff TSX.Term
|
||||
deriving instance DOTGraphDiff TypeScript.Term
|
||||
|
||||
@ -123,6 +125,7 @@ instance (ConstructorName syntax, Diffable syntax, Eq1 syntax, Hashable1 syntax,
|
||||
& P.edges .~ fmap toEdge (edgeList graph)
|
||||
& P.errors .~ mempty
|
||||
|
||||
deriving instance JSONGraphDiff PHP.Term
|
||||
deriving instance JSONGraphDiff TSX.Term
|
||||
deriving instance JSONGraphDiff TypeScript.Term
|
||||
|
||||
@ -136,6 +139,7 @@ class DiffTerms term => JSONTreeDiff term where
|
||||
instance (Diffable syntax, Eq1 syntax, Hashable1 syntax, ToJSONFields1 syntax, Traversable syntax) => JSONTreeDiff (Term syntax) where
|
||||
jsonTreeDiff = renderJSONDiff
|
||||
|
||||
deriving instance JSONTreeDiff PHP.Term
|
||||
deriving instance JSONTreeDiff TSX.Term
|
||||
deriving instance JSONTreeDiff TypeScript.Term
|
||||
|
||||
@ -149,6 +153,7 @@ class DiffTerms term => SExprDiff term where
|
||||
instance (ConstructorName syntax, Diffable syntax, Eq1 syntax, Hashable1 syntax, Traversable syntax) => SExprDiff (Term syntax) where
|
||||
sexprDiff = serialize (SExpression ByConstructorName)
|
||||
|
||||
deriving instance SExprDiff PHP.Term
|
||||
deriving instance SExprDiff TSX.Term
|
||||
deriving instance SExprDiff TypeScript.Term
|
||||
|
||||
@ -162,6 +167,7 @@ class DiffTerms term => ShowDiff term where
|
||||
instance (Diffable syntax, Eq1 syntax, Hashable1 syntax, Show1 syntax, Traversable syntax) => ShowDiff (Term syntax) where
|
||||
showDiff = serialize Show
|
||||
|
||||
deriving instance ShowDiff PHP.Term
|
||||
deriving instance ShowDiff TSX.Term
|
||||
deriving instance ShowDiff TypeScript.Term
|
||||
|
||||
@ -177,6 +183,7 @@ instance (Diffable syntax, Eq1 syntax, HasDeclaration syntax, Hashable1 syntax,
|
||||
decorateTerm = decoratorWithAlgebra . declarationAlgebra
|
||||
summarizeDiff = diffTOC
|
||||
|
||||
deriving instance SummarizeDiff PHP.Term
|
||||
deriving instance SummarizeDiff TSX.Term
|
||||
deriving instance SummarizeDiff TypeScript.Term
|
||||
|
||||
|
@ -18,6 +18,7 @@ import Data.Term
|
||||
import Data.Text (pack)
|
||||
import qualified Language.Java as Java
|
||||
import qualified Language.JSON as JSON
|
||||
import qualified Language.PHP.Term as PHP
|
||||
import qualified Language.Python as Python
|
||||
import qualified Language.TSX.Term as TSX
|
||||
import qualified Language.TypeScript.Term as TypeScript
|
||||
@ -113,6 +114,7 @@ class ToTags t where
|
||||
instance IsTaggable syntax => ToTags (Term syntax) where
|
||||
tags = runTagging
|
||||
|
||||
deriving instance ToTags PHP.Term
|
||||
deriving instance ToTags TSX.Term
|
||||
deriving instance ToTags TypeScript.Term
|
||||
|
||||
|
@ -41,6 +41,7 @@ import Source.Loc
|
||||
|
||||
import qualified Language.Java as Java
|
||||
import qualified Language.JSON as JSON
|
||||
import qualified Language.PHP.Term as PHP
|
||||
import qualified Language.Python as Python
|
||||
import qualified Language.TSX.Term as TSX
|
||||
import qualified Language.TypeScript.Term as TypeScript
|
||||
@ -119,6 +120,7 @@ instance ShowTerm JSON.Term where
|
||||
instance ShowTerm Python.Term where
|
||||
showTerm = serialize Show . void . Python.getTerm
|
||||
|
||||
deriving instance ShowTerm PHP.Term
|
||||
deriving instance ShowTerm TSX.Term
|
||||
deriving instance ShowTerm TypeScript.Term
|
||||
|
||||
@ -141,6 +143,7 @@ instance SExprTerm JSON.Term where
|
||||
instance SExprTerm Python.Term where
|
||||
sexprTerm = SExpr.Precise.serializeSExpression . Python.getTerm
|
||||
|
||||
deriving instance SExprTerm PHP.Term
|
||||
deriving instance SExprTerm TSX.Term
|
||||
deriving instance SExprTerm TypeScript.Term
|
||||
|
||||
@ -154,6 +157,7 @@ class DOTGraphTerm term where
|
||||
instance (ConstructorName syntax, Foldable syntax, Functor syntax) => DOTGraphTerm (Term syntax) where
|
||||
dotGraphTerm = serialize (DOT (termStyle "terms")) . renderTreeGraph
|
||||
|
||||
deriving instance DOTGraphTerm PHP.Term
|
||||
deriving instance DOTGraphTerm TSX.Term
|
||||
deriving instance DOTGraphTerm TypeScript.Term
|
||||
|
||||
@ -167,6 +171,7 @@ class JSONTreeTerm term where
|
||||
instance ToJSONFields1 syntax => JSONTreeTerm (Term syntax) where
|
||||
jsonTreeTerm = renderJSONTerm
|
||||
|
||||
deriving instance JSONTreeTerm PHP.Term
|
||||
deriving instance JSONTreeTerm TSX.Term
|
||||
deriving instance JSONTreeTerm TypeScript.Term
|
||||
|
||||
@ -190,5 +195,6 @@ instance (Foldable syntax, Functor syntax, ConstructorName syntax) => JSONGraphT
|
||||
& P.edges .~ fmap toEdge (edgeList graph)
|
||||
& P.errors .~ mempty
|
||||
|
||||
deriving instance JSONGraphTerm PHP.Term
|
||||
deriving instance JSONGraphTerm TSX.Term
|
||||
deriving instance JSONGraphTerm TypeScript.Term
|
||||
|
Loading…
Reference in New Issue
Block a user