Add semantic-tsx

cabal.project

@@ -7,6 +7,7 @@ packages: .
           semantic-json
           semantic-python
           semantic-ruby
+          semantic-tsx
           semantic-typescript
           semantic-tags
 

script/ghci-flags

@@ -45,6 +45,7 @@ function flags {
   echo "-isemantic-json/src"
   echo "-isemantic-python/src"
   echo "-isemantic-ruby/src"
+  echo "-isemantic-tsx/src"
   echo "-isemantic-typescript/src"
   echo "-isemantic-tags/src"
   echo "-iapp"

script/ghci-flags-dependencies

@@ -17,4 +17,5 @@ echo "semantic-java/semantic-java.cabal"
 echo "semantic-json/semantic-json.cabal"
 echo "semantic-python/semantic-python.cabal"
 echo "semantic-ruby/semantic-ruby.cabal"
+echo "semantic-tsx/semantic-tsx.cabal"
 echo "semantic-typescript/semantic-typescript.cabal"

semantic-tsx/LICENSE

@@ -0,0 +1,21 @@
+MIT License
+
+Copyright (c) 2019 GitHub
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

semantic-tsx/README.md

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

semantic-tsx/Setup.hs

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

semantic-tsx/semantic-tsx.cabal

@@ -0,0 +1,54 @@
+cabal-version:       2.4
+
+name:                semantic-tsx
+version:             0.0.0.0
+synopsis:            Semantic support for TSX.
+description:         Semantic support for TSX using the semantic-core intermediate language.
+homepage:            https://github.com/github/semantic/tree/master/semantic-tsx#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-core ^>= 0.0
+                     , semantic-source ^>= 0.0
+                     , semantic-tags ^>= 0.0
+                     , text ^>= 1.2.3
+                     , tree-sitter ^>= 0.7.2
+                     , tree-sitter-tsx ^>= 0.4
+
+  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.TSX
+    Language.TSX.Tags
+  hs-source-dirs: src

semantic-tsx/src/Language/TSX.hs

@@ -0,0 +1,21 @@
+{-# OPTIONS_GHC -freduction-depth=0 #-}
+-- | Semantic functionality for TSX programs.
+module Language.TSX
+( Term(..)
+, TreeSitter.TSX.tree_sitter_tsx
+) where
+
+
+import qualified Language.TSX.Tags as TsxTags
+import qualified Tags.Tagging.Precise as Tags
+import qualified TreeSitter.TSX (tree_sitter_tsx)
+import qualified TreeSitter.TSX.AST as TSX
+import qualified TreeSitter.Unmarshal as TS
+
+newtype Term a = Term { getTerm :: TSX.Program a }
+
+instance TS.Unmarshal Term where
+  unmarshalNode node = Term <$> TS.unmarshalNode node
+
+instance Tags.ToTags Term where
+  tags src = Tags.runTagging src . TsxTags.tags . getTerm

semantic-tsx/src/Language/TSX/Tags.hs

@@ -0,0 +1,134 @@
+{-# LANGUAGE AllowAmbiguousTypes, DataKinds, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, NamedFieldPuns, PartialTypeSignatures, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
+{-# OPTIONS_GHC -freduction-depth=0 #-}
+module Language.TSX.Tags
+( ToTags(..)
+) where
+
+import           AST.Element
+import           Control.Effect.Reader
+import           Control.Effect.Writer
+import           Data.Monoid (Ap (..))
+import           Data.Text as Text
+import           GHC.Generics
+import           Source.Loc
+import           Source.Source as Source
+import           Tags.Tag
+import qualified Tags.Tagging.Precise as Tags
+import qualified TreeSitter.TSX.AST as Tsx
+
+class ToTags t where
+  tags
+    :: ( Has (Reader Source) sig m
+       , Has (Writer Tags.Tags) sig m
+       )
+    => t Loc
+    -> m ()
+
+instance (ToTagsBy strategy t, strategy ~ ToTagsInstance t) => ToTags t where
+  tags = tags' @strategy
+
+
+class ToTagsBy (strategy :: Strategy) t where
+  tags'
+    :: ( Has (Reader Source) sig m
+       , Has (Writer Tags.Tags) sig m
+       )
+    => t Loc
+    -> m ()
+
+
+data Strategy = Generic | Custom
+
+type family ToTagsInstance t :: Strategy where
+  ToTagsInstance (_ :+: _)              = 'Custom
+  ToTagsInstance Tsx.Function            = 'Custom
+  ToTagsInstance Tsx.FunctionSignature   = 'Custom
+  ToTagsInstance Tsx.FunctionDeclaration = 'Custom
+  ToTagsInstance Tsx.MethodDefinition    = 'Custom
+  ToTagsInstance Tsx.ClassDeclaration    = 'Custom
+  ToTagsInstance Tsx.CallExpression      = 'Custom
+
+  ToTagsInstance Tsx.Class               = 'Custom
+
+  ToTagsInstance _                      = 'Generic
+
+instance ToTagsBy 'Custom Tsx.Function where
+  tags' t@Tsx.Function
+    { ann = loc@Loc { byteRange }
+    , name = Just Tsx.Identifier { text }
+    } = yieldTag text Function loc byteRange >> gtags t
+  tags' t = gtags t
+
+instance ToTagsBy 'Custom Tsx.FunctionSignature where
+  tags' t@Tsx.FunctionSignature
+    { ann = loc@Loc { byteRange }
+    , name = Tsx.Identifier { text }
+    } = yieldTag text Function loc byteRange >> gtags t
+
+instance ToTagsBy 'Custom Tsx.FunctionDeclaration where
+  tags' t@Tsx.FunctionDeclaration
+    { ann = loc@Loc { byteRange }
+    , name = Tsx.Identifier { text }
+    } = yieldTag text Function loc byteRange >> gtags t
+
+instance ToTagsBy 'Custom Tsx.MethodDefinition where
+  tags' t@Tsx.MethodDefinition
+    { ann = loc@Loc { byteRange }
+    , name
+    } = case name of
+      Prj Tsx.PropertyIdentifier { text } -> yield text
+      -- TODO: There are more here
+      _ -> gtags t
+      where
+        yield name = yieldTag name Call loc byteRange >> gtags t
+
+instance ToTagsBy 'Custom Tsx.ClassDeclaration where
+  tags' t@Tsx.ClassDeclaration
+    { ann = loc@Loc { byteRange }
+    , name = Tsx.TypeIdentifier { text }
+    } = yieldTag text Class loc byteRange >> gtags t
+
+instance ToTagsBy 'Custom Tsx.CallExpression where
+  tags' t@Tsx.CallExpression
+    { ann = loc@Loc { byteRange }
+    , function = Tsx.Expression expr
+    } = match expr
+    where
+      match expr = case expr of
+        Prj Tsx.Identifier { text } -> yield text
+        Prj Tsx.NewExpression { constructor = Prj Tsx.Identifier { text } } -> yield text
+        -- Prj Tsx.MemberExpression { property = Tsx.PropertyIdentifier { text }, object = (Tsx.Expression expr) } -> yieldTag text Call loc byteRange >> match expr
+        Prj Tsx.CallExpression { function = Tsx.Expression expr } -> match expr
+        Prj Tsx.MemberExpression { property = Tsx.PropertyIdentifier { text } } -> yield text
+        _ -> gtags t
+      yield name = yieldTag name Call loc byteRange >> gtags t
+
+instance ToTagsBy 'Custom Tsx.Class where
+  tags' t@Tsx.Class
+    { ann = loc@Loc { byteRange }
+    , name = Just Tsx.TypeIdentifier { text }
+    } = yieldTag text Class loc byteRange >> gtags t
+  tags' t = gtags t
+
+instance (ToTags l, ToTags r) => ToTagsBy 'Custom (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
+     , Generic1 t
+     , Tags.GFoldable1 ToTags (Rep1 t)
+     )
+  => t Loc
+  -> m ()
+gtags = getAp . Tags.gfoldMap1 @ToTags (Ap . tags) . from1
+
+instance (Generic1 t, Tags.GFoldable1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
+  tags' = gtags
+
+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
+  let sliced = slice src range
+  Tags.yield (Tag name kind loc (Tags.firstLine sliced) Nothing)

semantic.cabal

@@ -290,6 +290,7 @@ library
                      , semantic-json ^>= 0
                      , semantic-python ^>= 0
                      , semantic-ruby ^>= 0
+                     , semantic-tsx ^>= 0
                      , semantic-typescript ^>= 0
                      , semantic-tags ^>= 0
                      , semigroupoids ^>= 5.3.2

src/Data/Language.hs

@@ -155,6 +155,9 @@ data PerLanguageModes = PerLanguageModes
   , rubyMode   :: LanguageMode
   , goMode     :: LanguageMode
   , typescriptMode :: LanguageMode
+  , tsxMode :: LanguageMode
+  , javascriptMode :: LanguageMode
+  , jsxMode :: LanguageMode
   }
   deriving (Eq, Ord, Show)
 
@@ -164,6 +167,9 @@ defaultLanguageModes = PerLanguageModes
   , rubyMode = ALaCarte
   , goMode = ALaCarte
   , typescriptMode = ALaCarte
+  , tsxMode = ALaCarte
+  , javascriptMode = ALaCarte
+  , jsxMode = ALaCarte
   }
 
 data LanguageMode

src/Language/TSX/Assignment.hs

@@ -104,7 +104,7 @@ augmentedAssignmentExpression = makeTerm' <$> symbol AugmentedAssignmentExpressi
   , assign Expression.LShift <$ symbol AnonLAngleLAngleEqual
   , assign Expression.BOr <$ symbol AnonPipeEqual ])
   where assign :: (f :< TSX.Syntax) => (Term Loc -> Term Loc -> f (Term Loc)) -> Term Loc -> Term Loc -> Sum TSX.Syntax (Term Loc)
-        assign c l r = inject (Statement.Assignment [] l (makeTerm1 (c l r)))
+        assign c l r = inject (Statement.AugmentedAssignment (makeTerm1 (c l r)))
 
 
 awaitExpression :: Assignment (Term Loc)

src/Language/TSX/Term.hs

@@ -93,6 +93,7 @@ type Syntax =
   , Literal.TextElement
   , Literal.Regex
   , Statement.Assignment
+  , Statement.AugmentedAssignment
   , Statement.Break
   , Statement.Catch
   , Statement.Continue

src/Parsing/Parser.hs

@@ -8,8 +8,12 @@ module Parsing.Parser
 , goParserALaCarte
 , goParserPrecise
 , javaParser
+, javascriptParserALaCarte
+, javascriptParserPrecise
 , javascriptParser
 , jsonParser
+, jsxParserALaCarte
+, jsxParserPrecise
 , jsxParser
 , markdownParser
 , phpParser
@@ -19,6 +23,8 @@ module Parsing.Parser
 , rubyParserALaCarte
 , rubyParserPrecise
 , rubyParser
+, tsxParserALaCarte
+, tsxParserPrecise
 , tsxParser
 , typescriptParserALaCarte
 , typescriptParserPrecise
@@ -49,7 +55,8 @@ import qualified Language.Python as PythonPrecise
 import qualified Language.Python.Assignment as PythonALaCarte
 import qualified Language.Ruby as RubyPrecise
 import qualified Language.Ruby.Assignment as RubyALaCarte
-import qualified Language.TSX.Assignment as TSX
+import qualified Language.TSX as TSXPrecise
+import qualified Language.TSX.Assignment as TSXALaCarte
 import qualified Language.TypeScript as TypeScriptPrecise
 import qualified Language.TypeScript.Assignment as TypeScriptALaCarte
 import           Prelude hiding (fail)
@@ -123,14 +130,30 @@ goParser modes = case goMode modes of
 javaParser :: c Java.Term => (Language, SomeParser c Loc)
 javaParser = (Java, SomeParser (UnmarshalParser @Java.Term Java.tree_sitter_java))
 
-javascriptParser :: c TSX.Term => (Language, SomeParser c Loc)
-javascriptParser = (JavaScript, SomeParser (AssignmentParser (ASTParser tree_sitter_tsx) TSX.assignment))
+javascriptParserALaCarte :: c TSXALaCarte.Term => (Language, SomeParser c Loc)
+javascriptParserALaCarte = (JavaScript, SomeParser (AssignmentParser (ASTParser tree_sitter_tsx) TSXALaCarte.assignment))
+
+javascriptParserPrecise :: c TSXPrecise.Term => (Language, SomeParser c Loc)
+javascriptParserPrecise = (JavaScript, SomeParser (UnmarshalParser @TSXPrecise.Term TSXPrecise.tree_sitter_tsx))
+
+javascriptParser :: (c TSXALaCarte.Term, c TSXPrecise.Term) => PerLanguageModes -> (Language, SomeParser c Loc)
+javascriptParser modes = case javascriptMode modes of
+  ALaCarte -> javascriptParserALaCarte
+  Precise  -> javascriptParserPrecise
 
 jsonParser :: c JSON.Term => (Language, SomeParser c Loc)
 jsonParser = (JSON, SomeParser (UnmarshalParser @JSON.Term JSON.tree_sitter_json))
 
-jsxParser :: c TSX.Term => (Language, SomeParser c Loc)
-jsxParser = (JSX, SomeParser (AssignmentParser (ASTParser tree_sitter_tsx) TSX.assignment))
+jsxParserALaCarte :: c TSXALaCarte.Term => (Language, SomeParser c Loc)
+jsxParserALaCarte = (JSX, SomeParser (AssignmentParser (ASTParser tree_sitter_tsx) TSXALaCarte.assignment))
+
+jsxParserPrecise :: c TSXPrecise.Term => (Language, SomeParser c Loc)
+jsxParserPrecise = (JSX, SomeParser (UnmarshalParser @TSXPrecise.Term TSXPrecise.tree_sitter_tsx))
+
+jsxParser :: (c TSXALaCarte.Term, c TSXPrecise.Term) => PerLanguageModes -> (Language, SomeParser c Loc)
+jsxParser modes = case jsxMode modes of
+  ALaCarte -> jsxParserALaCarte
+  Precise  -> jsxParserPrecise
 
 markdownParser :: c Markdown.Term => (Language, SomeParser c Loc)
 markdownParser = (Markdown, SomeParser (AssignmentParser MarkdownParser Markdown.assignment))
@@ -160,8 +183,16 @@ rubyParser modes = case rubyMode modes of
   ALaCarte -> rubyParserALaCarte
   Precise  -> rubyParserPrecise
 
-tsxParser :: c TSX.Term => (Language, SomeParser c Loc)
-tsxParser = (TSX, SomeParser (AssignmentParser (ASTParser tree_sitter_tsx) TSX.assignment))
+tsxParserALaCarte :: c TSXALaCarte.Term => (Language, SomeParser c Loc)
+tsxParserALaCarte = (TSX, SomeParser (AssignmentParser (ASTParser tree_sitter_tsx) TSXALaCarte.assignment))
+
+tsxParserPrecise :: c TSXPrecise.Term => (Language, SomeParser c Loc)
+tsxParserPrecise = (TSX, SomeParser (UnmarshalParser @TSXPrecise.Term TSXPrecise.tree_sitter_tsx))
+
+tsxParser :: (c TSXALaCarte.Term, c TSXPrecise.Term) => PerLanguageModes -> (Language, SomeParser c Loc)
+tsxParser modes = case tsxMode modes of
+  ALaCarte -> tsxParserALaCarte
+  Precise  -> tsxParserPrecise
 
 typescriptParserALaCarte :: c TypeScriptALaCarte.Term => (Language, SomeParser c Loc)
 typescriptParserALaCarte = (TypeScript, SomeParser (AssignmentParser (ASTParser tree_sitter_typescript) TypeScriptALaCarte.assignment))
@@ -183,6 +214,7 @@ type family TermMode term where
   TermMode PythonPrecise.Term     = 'Precise
   TermMode RubyPrecise.Term       = 'Precise
   TermMode TypeScriptPrecise.Term = 'Precise
+  TermMode TSXPrecise.Term        = 'Precise
   TermMode _                      = 'ALaCarte
 
 -- | The canonical set of parsers producing à la carte terms.
@@ -192,20 +224,20 @@ aLaCarteParsers
      , c PHP.Term
      , c PythonALaCarte.Term
      , c RubyALaCarte.Term
-     , c TSX.Term
+     , c TSXALaCarte.Term
      , c TypeScriptALaCarte.Term
      )
   => Map Language (SomeParser c Loc)
 aLaCarteParsers = Map.fromList
-  [ goParserALaCarte
-  , javascriptParser
-  , jsxParser
+  [ javascriptParserALaCarte
+  , jsxParserALaCarte
   , markdownParser
   , phpParser
   , pythonParserALaCarte
   , rubyParserALaCarte
+  , tsxParserALaCarte
   , typescriptParserALaCarte
-  , tsxParser
+  , goParserALaCarte
   ]
 
 -- | The canonical set of parsers producing precise terms.
@@ -216,15 +248,19 @@ preciseParsers
      , c RubyPrecise.Term
      , c GoPrecise.Term
      , c TypeScriptPrecise.Term
+     , c TSXPrecise.Term
      )
   => Map Language (SomeParser c Loc)
 preciseParsers = Map.fromList
-  [ javaParser
+  [ goParserPrecise
+  , javascriptParserPrecise
   , jsonParser
+  , jsxParserPrecise
   , pythonParserPrecise
   , rubyParserPrecise
-  , goParserPrecise
+  , tsxParserPrecise
   , typescriptParserPrecise
+  , javaParser
   ]
 
 -- | The canonical set of all parsers for the passed per-language modes.
@@ -239,7 +275,8 @@ allParsers
      , c PythonPrecise.Term
      , c RubyALaCarte.Term
      , c RubyPrecise.Term
-     , c TSX.Term
+     , c TSXALaCarte.Term
+     , c TSXPrecise.Term
      , c TypeScriptALaCarte.Term
      , c TypeScriptPrecise.Term
      )
@@ -248,13 +285,13 @@ allParsers
 allParsers modes = Map.fromList
   [ goParser modes
   , javaParser
-  , javascriptParser
+  , javascriptParser modes
   , jsonParser
-  , jsxParser
+  , jsxParser modes
   , markdownParser
   , phpParser
   , pythonParser modes
   , rubyParser modes
+  , tsxParser modes
   , typescriptParser modes
-  , tsxParser
   ]

src/Semantic/Api/Terms.hs

@@ -45,6 +45,7 @@ import qualified Language.Go as GoPrecise
 import qualified Language.Python as PythonPrecise
 import qualified Language.Ruby as RubyPrecise
 import qualified Language.TypeScript as TypeScriptPrecise
+import qualified Language.TSX as TSXPrecise
 
 
 termGraph :: (Traversable t, Has Distribute sig m, Has (Error SomeException) sig m, Has Parse sig m) => t Blob -> m ParseTreeGraphResponse
@@ -126,6 +127,9 @@ instance ShowTermBy 'Precise PythonPrecise.Term where
 instance ShowTermBy 'Precise RubyPrecise.Term where
   showTermBy = serialize Show . void . RubyPrecise.getTerm
 
+instance ShowTermBy 'Precise TSXPrecise.Term where
+  showTermBy = serialize Show . void . TSXPrecise.getTerm
+
 instance ShowTermBy 'Precise TypeScriptPrecise.Term where
   showTermBy = serialize Show . void . TypeScriptPrecise.getTerm
 
@@ -160,6 +164,9 @@ instance SExprTermBy 'Precise PythonPrecise.Term where
 instance SExprTermBy 'Precise RubyPrecise.Term where
   sexprTermBy = SExpr.Precise.serializeSExpression . RubyPrecise.getTerm
 
+instance SExprTermBy 'Precise TSXPrecise.Term where
+  sexprTermBy = SExpr.Precise.serializeSExpression . TSXPrecise.getTerm
+
 instance SExprTermBy 'Precise TypeScriptPrecise.Term where
   sexprTermBy = SExpr.Precise.serializeSExpression . TypeScriptPrecise.getTerm
 

src/Semantic/CLI.hs

@@ -188,6 +188,20 @@ languageModes = Language.PerLanguageModes
                   <> metavar "ALaCarte|Precise"
                   <> value Language.ALaCarte
                   <> showDefault)
+  <*> option auto (  long "tsx-mode"
+                  <> help "The AST representation to use for TSX sources"
+                  <> metavar "ALaCarte|Precise"
+                  <> value Language.ALaCarte
+                  <> showDefault)
+  <*> languageModeOption "javascript" "JavaScript"
+  <*> languageModeOption "jsx" "JSX"
+  where
+    languageModeOption shortName fullName
+      = option auto (  long (shortName <> "-mode")
+                    <> help ("The AST representation to use for " <> fullName <> " sources")
+                    <> metavar "ALaCarte|Precise"
+                    <> value Language.ALaCarte
+                    <> showDefault)
 
 filePathReader :: ReadM File
 filePathReader = fileForPath <$> str

src/Semantic/Graph.hs

@@ -105,12 +105,12 @@ instance
 analysisParsers :: Map Language (SomeParser AnalyzeTerm Loc)
 analysisParsers = Map.fromList
   [ goParserALaCarte
-  , javascriptParser
+  , javascriptParserALaCarte
   , phpParser
   , pythonParserALaCarte
   , rubyParserALaCarte
   , typescriptParserALaCarte
-  , tsxParser
+  , tsxParserALaCarte
   ]
 
 runGraph :: ( Has Distribute sig m