diff --git a/semantic-diff.cabal b/semantic-diff.cabal index 8847943f3..5d249deb5 100644 --- a/semantic-diff.cabal +++ b/semantic-diff.cabal @@ -54,7 +54,6 @@ library , Language.Go.Syntax , Language.JSON.Grammar , Language.JSON.Syntax - , Language.Ruby , Language.Ruby.Grammar , Language.Ruby.Syntax , Language.TypeScript.Grammar diff --git a/src/Language/Ruby.hs b/src/Language/Ruby.hs deleted file mode 100644 index d76db7809..000000000 --- a/src/Language/Ruby.hs +++ /dev/null @@ -1,178 +0,0 @@ -{-# LANGUAGE DataKinds #-} -module Language.Ruby where - -import Control.Comonad -import Control.Comonad.Cofree -import Data.Foldable (toList) -import Data.List (partition) -import Data.Semigroup -import Data.Source -import Data.Text (Text) -import Info -import Language -import qualified Syntax as S -import Term hiding ((:<)) - -termAssignment - :: Source -- ^ The source of the term. - -> Category -- ^ The category for the term. - -> [ SyntaxTerm DefaultFields ] -- ^ The child nodes of the term. - -> Maybe (S.Syntax (SyntaxTerm DefaultFields)) -- ^ The resulting term, in Maybe. -termAssignment _ category children - = case (category, children) of - (ArgumentPair, [ k, v ] ) -> Just $ S.Pair k v - (KeywordParameter, [ k, v ] ) -> Just $ S.Pair k v - -- NB: ("keyword_parameter", k) is a required keyword parameter, e.g.: - -- def foo(name:); end - -- Let it fall through to generate an Indexed syntax. - (OptionalParameter, [ k, v ] ) -> Just $ S.Pair k v - (AnonymousFunction, first : rest) - | null rest -> Just $ S.AnonymousFunction [] [first] - | otherwise -> Just $ S.AnonymousFunction (toList (unwrap first)) rest - (ArrayLiteral, _ ) -> Just $ S.Array Nothing children - (Assignment, [ identifier, value ]) -> Just $ S.Assignment identifier value - (Begin, _ ) -> Just $ case partition (\x -> Info.category (extract x) == Rescue) children of - (rescues, rest) -> case partition (\x -> Info.category (extract x) == Ensure || Info.category (extract x) == Else) rest of - (ensureElse, body) -> case ensureElse of - [ elseBlock, ensure ] - | Else <- Info.category (extract elseBlock) - , Ensure <- Info.category (extract ensure) -> S.Try body rescues (Just elseBlock) (Just ensure) - [ ensure, elseBlock ] - | Ensure <- Info.category (extract ensure) - , Else <- Info.category (extract elseBlock) -> S.Try body rescues (Just elseBlock) (Just ensure) - [ elseBlock ] | Else <- Info.category (extract elseBlock) -> S.Try body rescues (Just elseBlock) Nothing - [ ensure ] | Ensure <- Info.category (extract ensure) -> S.Try body rescues Nothing (Just ensure) - _ -> S.Try body rescues Nothing Nothing - (Class, constant : superclass : body) - | Superclass <- Info.category (extract superclass) - -> Just $ S.Class constant [superclass] body - (Class, constant : rest) -> Just $ S.Class constant [] rest - (SingletonClass, identifier : rest) -> Just $ S.Class identifier [] rest - (Case, _) -> Just $ uncurry S.Switch (break ((== When) . Info.category . extract) children) - (When, expr : body) -> Just $ S.Case expr body - (Ternary, condition : cases) -> Just $ S.Ternary condition cases - (MethodCall, fn : args) - | MemberAccess <- Info.category (extract fn) - , [target, method] <- toList (unwrap fn) - -> Just $ S.MethodCall target method [] (toList . unwrap =<< args) - | otherwise - -> Just $ S.FunctionCall fn [] (toList . unwrap =<< args) - (Object, _ ) -> Just . S.Object Nothing $ foldMap toTuple children - (Modifier If, [ lhs, condition ]) -> Just $ S.If condition [lhs] - (Modifier Unless, [lhs, rhs]) -> Just $ S.If (setCategory (extract rhs) Negate :< S.Negate rhs) [lhs] - (Unless, expr : rest) -> Just $ S.If ((setCategory (extract expr) Negate) :< S.Negate expr) rest - (Modifier Until, [ lhs, rhs ]) -> Just $ S.While (setCategory (extract rhs) Negate :< S.Negate rhs) [lhs] - (Until, expr : rest) -> Just $ S.While (setCategory (extract expr) Negate :< S.Negate expr) rest - (Elsif, condition : body ) -> Just $ S.If condition body - (SubscriptAccess, [ base, element ]) -> Just $ S.SubscriptAccess base element - (For, lhs : expr : rest ) -> Just $ S.For [lhs, expr] rest - (OperatorAssignment, [ identifier, value ]) -> Just $ S.OperatorAssignment identifier value - (MemberAccess, [ base, property ]) -> Just $ S.MemberAccess base property - (SingletonMethod, expr : methodName : rest) - | params : body <- rest - , Params <- Info.category (extract params) - -> Just $ S.Method [] methodName (Just expr) [params] body - | Identifier <- Info.category (extract methodName) - -> Just $ S.Method [] methodName (Just expr) [] rest - (Method, identifier : rest) - | params : body <- rest - , Params <- Info.category (extract params) - -> Just $ S.Method [] identifier Nothing [params] body - | otherwise - -> Just $ S.Method [] identifier Nothing [] rest - (Module, constant : body ) -> Just $ S.Module constant body - (Modifier Rescue, [lhs, rhs] ) -> Just $ S.Rescue [lhs] [rhs] - (Rescue, exceptions : exceptionVar : rest) - | RescueArgs <- Info.category (extract exceptions) - , RescuedException <- Info.category (extract exceptionVar) - -> Just $ S.Rescue (toList (unwrap exceptions) <> [exceptionVar]) rest - (Rescue, exceptionVar : rest) - | RescuedException <- Info.category (extract exceptionVar) - -> Just $ S.Rescue [exceptionVar] rest - (Rescue, exceptions : body) - | RescueArgs <- Info.category (extract exceptions) - -> Just $ S.Rescue (toList (unwrap exceptions)) body - (Rescue, body) -> Just $ S.Rescue [] body - (Modifier While, [ lhs, condition ]) -> Just $ S.While condition [lhs] - _ | category `elem` [ BeginBlock, EndBlock ] -> Just $ S.BlockStatement children - _ -> Nothing - -categoryForRubyName :: Text -> Category -categoryForRubyName name = case name of - "argument_list_with_parens" -> Args - "argument_list" -> Args - "argument_pair" -> ArgumentPair - "array" -> ArrayLiteral - "assignment" -> Assignment - "begin_block" -> BeginBlock - "begin" -> Begin - "binary" -> Binary - "block" -> ExpressionStatements - "block_parameter" -> BlockParameter - "block_parameters" -> Params - "boolean" -> Boolean - "call" -> MemberAccess - "case" -> Case - "class" -> Class - "comment" -> Comment - "conditional" -> Ternary - "constant" -> Constant - "element_reference" -> SubscriptAccess - "else" -> Else - "elsif" -> Elsif - "empty_statement" -> Empty - "end_block" -> EndBlock - "ensure" -> Ensure - "exception_variable" -> RescuedException - "exceptions" -> RescueArgs - "false" -> Boolean - "float" -> NumberLiteral - "for" -> For - "hash_splat_parameter" -> HashSplatParameter - "hash" -> Object - "identifier" -> Identifier - "if_modifier" -> Modifier If - "if" -> If - "instance_variable" -> Identifier - "integer" -> IntegerLiteral - "interpolation" -> Interpolation - "keyword_parameter" -> KeywordParameter - "lambda_parameters" -> Params - "lambda" -> AnonymousFunction - "left_assignment_list" -> Args - "method_call" -> MethodCall - "method_parameters" -> Params - "method" -> Method - "module" -> Module - "nil" -> Identifier - "operator_assignment" -> OperatorAssignment - "optional_parameter" -> OptionalParameter - "pair" -> Pair - "pattern" -> Args - "program" -> Program - "range" -> RangeExpression - "regex" -> Regex - "rescue_modifier" -> Modifier Rescue - "rescue" -> Rescue - "rest_assignment" -> SplatParameter - "return" -> Return - "scope_resolution" -> ScopeOperator - "self" -> Identifier - "singleton_class" -> SingletonClass - "singleton_method" -> SingletonMethod - "splat_parameter" -> SplatParameter - "string" -> StringLiteral - "subshell" -> Subshell - "superclass" -> Superclass - "symbol" -> SymbolLiteral - "true" -> Boolean - "unary" -> Unary - "unless_modifier" -> Modifier Unless - "unless" -> Unless - "until_modifier" -> Modifier Until - "until" -> Until - "when" -> When - "while_modifier" -> Modifier While - "while" -> While - "yield" -> Yield - s -> Other s diff --git a/src/TreeSitter.hs b/src/TreeSitter.hs index 9e5e0951a..e4d3d9ad4 100644 --- a/src/TreeSitter.hs +++ b/src/TreeSitter.hs @@ -21,7 +21,6 @@ import qualified Data.Syntax.Assignment as A import Data.Text (Text, pack) import Language import qualified Language.Go as Go -import qualified Language.Ruby as Ruby import Foreign import Foreign.C.String (peekCString) import Foreign.Marshal.Array (allocaArray) @@ -115,7 +114,6 @@ assignTerm language source annotation children allChildren = where assignTermByLanguage :: Source -> Category -> [ SyntaxTerm DefaultFields ] -> Maybe (S.Syntax (SyntaxTerm DefaultFields)) assignTermByLanguage = case languageForTSLanguage language of Just Language.Go -> Go.termAssignment - Just Ruby -> Ruby.termAssignment _ -> \ _ _ _ -> Nothing defaultTermAssignment :: Source -> Record DefaultFields -> [ SyntaxTerm DefaultFields ] -> IO [ SyntaxTerm DefaultFields ] -> IO (SyntaxTerm DefaultFields) @@ -192,7 +190,6 @@ categoryForLanguageProductionName = withDefaults . byLanguage s -> productionMap s byLanguage language = case languageForTSLanguage language of - Just Ruby -> Ruby.categoryForRubyName Just Language.Go -> Go.categoryForGoName _ -> Other @@ -200,6 +197,5 @@ categoryForLanguageProductionName = withDefaults . byLanguage languageForTSLanguage :: Ptr TS.Language -> Maybe Language languageForTSLanguage = flip lookup [ (TS.tree_sitter_go, Language.Go) - , (TS.tree_sitter_ruby, Ruby) , (TS.tree_sitter_typescript, TypeScript) ]