github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-24 08:54:07 +03:00
Code Issues Projects Releases Wiki Activity

Add semantic-ql

Browse Source
This commit is contained in:
Rick Winfrey 2020-03-02 11:18:21 -08:00
parent eb2bbb14ae
commit e4ffc9d2f6
10 changed files with 376 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
semantic-ql/CHANGELOG.md Normal file
View File

@ -0,0 +1,5 @@
# Revision history for semantic-ql
## 0.1.0.0 -- YYYY-mm-dd
* First version. Released on an unsuspecting world.

3
semantic-ql/README.md Normal file
View File

@ -0,0 +1,3 @@
# Semantic support for QL
This package implements `semantic` support for QL using the `semantic-core` intermediate language.

2
semantic-ql/Setup.hs Normal file
View File

@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain

58
semantic-ql/semantic-ql.cabal Normal file
View File

@ -0,0 +1,58 @@
cabal-version: 2.4
name: semantic-ql
version: 0.0.0.0
synopsis: Semantic support for QL.
description: Semantic support for QL using the semantic-core intermediate language.
homepage: https://github.com/github/semantic/tree/master/semantic-ql#readme
bug-reports: https://github.com/github/semantic/issues
license: MIT
license-file: LICENSE
author: The Semantic authors
maintainer: opensource+semantic@github.com
copyright: (c) 2019 GitHub, Inc.
category: Language
build-type: Simple
stability: alpha
extra-source-files: README.md
tested-with: GHC == 8.6.5
common haskell
default-language: Haskell2010
build-depends: base ^>= 4.13
, fused-effects ^>= 1.0
, fused-syntax
, parsers ^>= 0.12.10
, semantic-ast
, semantic-core ^>= 0.0
, semantic-source ^>= 0.0.2
, semantic-tags ^>= 0.0
, template-haskell ^>= 2.15
, text ^>= 1.2.3
, tree-sitter ^>= 0.9
, tree-sitter-ql
ghc-options:
-Weverything
-Wno-missing-local-signatures
-Wno-missing-import-lists
-Wno-implicit-prelude
-Wno-safe
-Wno-unsafe
-Wno-name-shadowing
-Wno-monomorphism-restriction
-Wno-missed-specialisations
-Wno-all-missed-specialisations
-Wno-star-is-type
if (impl(ghc >= 8.8))
ghc-options: -Wno-missing-deriving-strategies
library
import: haskell
exposed-modules:
Language.QL
Language.QL.AST
Language.QL.Grammar
Language.QL.Tags
hs-source-dirs: src

24
semantic-ql/src/Language/QL.hs Normal file
View File

@ -0,0 +1,24 @@
-- | Semantic functionality for QL programs.
module Language.QL
( Term(..)
, TreeSitter.QL.tree_sitter_ql
) where
import qualified AST.Unmarshal as TS
import Data.Proxy
import qualified Language.QL.AST as QL
import qualified Language.QL.Tags as QLTags
import qualified Tags.Tagging.Precise as Tags
import qualified TreeSitter.QL (tree_sitter_ql)
newtype Term a = Term { getTerm :: QL.Ql a }
instance TS.SymbolMatching Term where
matchedSymbols _ = TS.matchedSymbols (Proxy :: Proxy QL.Ql)
showFailure _ = TS.showFailure (Proxy :: Proxy QL.Ql)
instance TS.Unmarshal Term where
matchers = fmap (fmap (TS.hoist Term)) TS.matchers
instance Tags.ToTags Term where
tags src = Tags.runTagging src . QLTags.tags . getTerm

23
semantic-ql/src/Language/QL/AST.hs Normal file
View File

@ -0,0 +1,23 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
module Language.QL.AST
( module Language.QL.AST
) where
import AST.GenerateSyntax
import AST.Token()
import Language.Haskell.TH.Syntax (runIO)
import Prelude hiding (Bool, Eq, Float, Integer, String)
import qualified TreeSitter.QL as QL (getNodeTypesPath, tree_sitter_ql)
runIO QL.getNodeTypesPath >>= astDeclarationsForLanguage QL.tree_sitter_ql

12
semantic-ql/src/Language/QL/Grammar.hs Normal file
View File

@ -0,0 +1,12 @@
{-# LANGUAGE TemplateHaskell #-}
module Language.QL.Grammar
( tree_sitter_ql
, Grammar(..)
) where
import AST.Grammar.TH
import Language.Haskell.TH
import TreeSitter.QL (tree_sitter_ql)
-- | Statically-known rules corresponding to symbols in the grammar.
mkStaticallyKnownRuleGrammarData (mkName "Grammar") tree_sitter_ql

238
semantic-ql/src/Language/QL/Tags.hs Normal file
View File

@ -0,0 +1,238 @@
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Language.QL.Tags (tags) where
import AST.Element
import AST.Token
import AST.Traversable1
import Control.Effect.Reader
import Control.Effect.Writer
import Data.Text (Text)
import qualified Language.QL.AST as QL
import Source.Loc
import Source.Source as Source
import Tags.Tag
import qualified Tags.Tagging.Precise as Tags
class ToTags t where
tags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
)
=> t Loc
-> m ()
default tags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
, Traversable1 ToTags t
)
=> t Loc
-> m ()
tags = gtags
instance ToTags (Token sym n) where tags _ = pure ()
instance (ToTags l, ToTags r) => ToTags (l :+: r) where
tags (L1 l) = tags l
tags (R1 r) = tags r
gtags
:: ( Has (Reader Source) sig m
, Has (Writer Tags.Tags) sig m
, Traversable1 ToTags t
)
=> t Loc
-> m ()
gtags = traverse1_ @ToTags (const (pure ())) tags
yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> Kind -> Loc -> Range -> m ()
yieldTag name kind loc range = do
src <- ask @Source
Tags.yield (Tag name kind loc (Tags.firstLine src range) Nothing)
-- instance ToTags QL.FunctionDefinition where
-- tags t@QL.FunctionDefinition
-- { QL.ann = loc@Loc { byteRange }
-- , QL.name = QL.Name { text }
-- } = yieldTag text Method loc byteRange >> gtags t
--
-- instance ToTags QL.MethodDeclaration where
-- tags t@QL.MethodDeclaration
-- { QL.ann = loc@Loc { byteRange }
-- , QL.name = QL.Name { text }
-- } = yieldTag text Function loc byteRange >> gtags t
--
-- instance ToTags QL.FunctionCallExpression where
-- tags t@QL.FunctionCallExpression
-- { QL.ann = loc@Loc { byteRange }
-- , QL.function = func
-- } = match func
-- where
-- yield name = yieldTag name Call loc byteRange >> gtags t
-- match expr = case expr of
-- Prj (QL.VariableName { extraChildren = QL.Name { text } })
-- -> yield text *> gtags t
-- Prj (QL.QualifiedName { extraChildren = [Prj (QL.Name { text })] })
-- -> yield text *> gtags t
-- _
-- -> gtags t
--
-- instance ToTags QL.MemberCallExpression where
-- tags t@QL.MemberCallExpression
-- { QL.ann = loc@Loc { byteRange }
-- , QL.name = item
-- } = case item of
-- Prj (QL.Name { text }) -> yieldTag text Call loc byteRange >> gtags t
-- _ -> gtags t
--
--
instance ToTags QL.Module where
tags t@QL.Module
{ QL.ann = loc@Loc { byteRange }
, QL.name = QL.ModuleName { QL.name = QL.SimpleId { text } }
} = yieldTag text Module loc byteRange >> gtags t
instance ToTags QL.ClasslessPredicate where
tags t@QL.ClasslessPredicate
{ QL.ann = loc@Loc { byteRange }
, QL.name = QL.PredicateName { text }
} = yieldTag text Function loc byteRange >> gtags t
instance ToTags QL.AritylessPredicateExpr where
tags t@QL.AritylessPredicateExpr
{ QL.ann = loc@Loc { byteRange }
, QL.name = QL.LiteralId { text }
} = yieldTag text Call loc byteRange >> gtags t
instance ToTags QL.Dataclass
instance ToTags QL.MemberPredicate
instance ToTags QL.Datatype
instance ToTags QL.DatatypeBranch
instance ToTags QL.MemberCall
instance ToTags QL.AddExpr
instance ToTags QL.Any
instance ToTags QL.ExprAggregateBody
instance ToTags QL.ModuleName
instance ToTags QL.Strictconcat
instance ToTags QL.Addop
instance ToTags QL.Extends
instance ToTags QL.MulExpr
instance ToTags QL.Strictcount
instance ToTags QL.AggId
instance ToTags QL.As
instance ToTags QL.False
instance ToTags QL.Mulop
instance ToTags QL.Strictsum
instance ToTags QL.Aggregate
instance ToTags QL.AsExpr
instance ToTags QL.Field
instance ToTags QL.Ne
instance ToTags QL.String
instance ToTags QL.AnnotArg
instance ToTags QL.AsExprs
instance ToTags QL.Float
instance ToTags QL.Negation
instance ToTags QL.Sum
instance ToTags QL.AnnotName
instance ToTags QL.Asc
instance ToTags QL.Forall
instance ToTags QL.Newtype
instance ToTags QL.Super
instance ToTags QL.Annotation
instance ToTags QL.Avg
instance ToTags QL.Forex
instance ToTags QL.None
instance ToTags QL.SuperRef
instance ToTags QL.Body
instance ToTags QL.FullAggregateBody
instance ToTags QL.Not
instance ToTags QL.This
instance ToTags QL.Bool
instance ToTags QL.Ge
instance ToTags QL.OrderBy
instance ToTags QL.True
instance ToTags QL.Boolean
instance ToTags QL.Gt
instance ToTags QL.OrderBys
instance ToTags QL.TypeAliasBody
instance ToTags QL.Charpred
instance ToTags QL.HigherOrderTerm
instance ToTags QL.ParExpr
instance ToTags QL.TypeExpr
instance ToTags QL.IfTerm
instance ToTags QL.Plus
instance ToTags QL.TypeLiteral
instance ToTags QL.ClassMember
instance ToTags QL.Implication
instance ToTags QL.UnaryExpr
instance ToTags QL.ClassName
instance ToTags QL.Import
instance ToTags QL.PredicateAliasBody
instance ToTags QL.Underscore
instance ToTags QL.Predicate
instance ToTags QL.ImportModuleExpr
instance ToTags QL.PredicateExpr
instance ToTags QL.Unop
instance ToTags QL.Imprt
instance ToTags QL.PredicateName
instance ToTags QL.VarDecl
instance ToTags QL.Closure
instance ToTags QL.In
instance ToTags QL.PrefixCast
instance ToTags QL.VarName
instance ToTags QL.CompTerm
instance ToTags QL.InExpr
instance ToTags QL.Ql
instance ToTags QL.Variable
instance ToTags QL.Compop
instance ToTags QL.InstanceOf
instance ToTags QL.Qldoc
instance ToTags QL.Concat
instance ToTags QL.Instanceof
instance ToTags QL.QualModuleExpr
instance ToTags QL.Conjunction
instance ToTags QL.Integer
instance ToTags QL.QualifiedExpr
instance ToTags QL.Count
instance ToTags QL.Le
instance ToTags QL.PostfixCast
instance ToTags QL.Class
instance ToTags QL.Literal
instance ToTags QL.Quantified
instance ToTags QL.LiteralId
instance ToTags QL.Quantifier
instance ToTags QL.Lt
instance ToTags QL.Range
instance ToTags QL.DatatypeBranches
instance ToTags QL.Max
instance ToTags QL.Rank
instance ToTags QL.Date
instance ToTags QL.Result
instance ToTags QL.Dbtype
instance ToTags QL.Min
instance ToTags QL.ReturnType
instance ToTags QL.Desc
instance ToTags QL.Minus
instance ToTags QL.Select
instance ToTags QL.Direction
instance ToTags QL.Mod
instance ToTags QL.SimpleId
instance ToTags QL.Disjunction
instance ToTags QL.Slash
instance ToTags QL.Empty
instance ToTags QL.ModuleAliasBody
instance ToTags QL.SpecialCall
instance ToTags QL.Eq
instance ToTags QL.ModuleExpr
instance ToTags QL.SpecialId
instance ToTags QL.Exists
instance ToTags QL.ModuleMember
instance ToTags QL.Star
instance ToTags QL.ClasslessPredicateCall

12
semantic-source/src/Source/Language.hs
View File

@ -37,6 +37,7 @@ data Language
| Ruby
| TypeScript
| PHP
| QL
| TSX
deriving (Eq, Generic, Ord, Read, Show, Bounded, Hashable, ToJSON, Enum)
@ -68,18 +69,21 @@ instance SLanguage 'JSX where
instance SLanguage 'Markdown where
reflect _ = Markdown
instance SLanguage 'PHP where
reflect _ = PHP
instance SLanguage 'Python where
reflect _ = Python
instance SLanguage 'QL where
reflect _ = QL
instance SLanguage 'Ruby where
reflect _ = Ruby
instance SLanguage 'TypeScript where
reflect _ = TypeScript
instance SLanguage 'PHP where
reflect _ = PHP
instance FromJSON Language where
parseJSON = withText "Language" $ \l ->
pure $ textToLanguage l
@ -118,6 +122,7 @@ languageToText = \case
TypeScript -> "TypeScript"
TSX -> "TSX"
PHP -> "PHP"
QL -> "QL"
textToLanguage :: T.Text -> Language
textToLanguage = \case
@ -133,4 +138,5 @@ textToLanguage = \case
"TypeScript" -> TypeScript
"TSX" -> TSX
"PHP" -> PHP
"QL" -> QL
_ -> Unknown

3
semantic.cabal
View File

@ -69,7 +69,7 @@ common dependencies
, safe-exceptions ^>= 0.1.7.0
, semantic-analysis ^>= 0
, semantic-ast
, semantic-source ^>= 0.0.2
, semantic-source
, semilattices ^>= 0.0.0.3
, streaming ^>= 0.2.2.0
, text ^>= 1.2.3.1
@ -284,6 +284,7 @@ library
, semantic-json ^>= 0
, semantic-php ^>= 0
, semantic-python ^>= 0
, semantic-ql ^>= 0
, semantic-ruby ^>= 0
, semantic-scope-graph ^>= 0
, semantic-tags ^>= 0