mirror of
https://github.com/github/semantic.git
synced 2025-01-05 05:58:34 +03:00
Merge pull request #935 from github/term-assignment-matches-on-categories
Term assignment matches on categories
This commit is contained in:
Rob Rix
GitHub
commit
b65b2062ed
@ -135,6 +135,7 @@ data Category
|
||||
| Elsif
|
||||
| Ensure
|
||||
| Rescue
|
||||
-- | Formerly used for Ruby’s @x rescue y@ modifier syntax. Deprecated. Use @Modifier Rescue@ instead. Left in place to preserve hashing & RWS results.
|
||||
| RescueModifier
|
||||
| RescuedException
|
||||
| RescueArgs
|
||||
@ -222,8 +223,13 @@ data Category
|
||||
| FieldDeclarations
|
||||
-- | A Go rune literal.
|
||||
| RuneLiteral
|
||||
-- | A modifier version of another Category, e.g. Ruby’s trailing @if@, @while@, etc. terms, whose subterms are swapped relative to regular @if@, @while@, etc. terms.
|
||||
| Modifier Category
|
||||
deriving (Eq, Generic, Ord, Show)
|
||||
|
||||
{-# DEPRECATED RescueModifier "Deprecated; use Modifier Rescue instead." #-}
|
||||
|
||||
|
||||
-- Instances
|
||||
|
||||
instance Hashable Category
|
||||
@ -347,3 +353,4 @@ instance Listable Category where
|
||||
\/ cons0 FieldDeclarations
|
||||
\/ cons0 RuneLiteral
|
||||
\/ cons1 (Other . unListableText)
|
||||
\/ cons1 Modifier
|
||||
|
||||
@ -1,5 +1,7 @@
|
||||
{-# LANGUAGE DataKinds, TypeFamilies, ScopedTypeVariables, DeriveAnyClass #-}
|
||||
{-# OPTIONS_GHC -funbox-strict-fields #-}
|
||||
{-# OPTIONS_GHC -Wno-deprecations #-}
|
||||
-- Disabling deprecation warnings due to pattern match against RescueModifier.
|
||||
|
||||
module DiffSummary (diffSummaries, DiffSummary(..), DiffInfo(..), diffToDiffSummaries, isBranchInfo, isErrorSummary, JSONSummary(..)) where
|
||||
|
||||
@ -294,7 +296,7 @@ parentContexts contexts = hsep $ either identifiableDoc annotatableDoc <$> conte
|
||||
C.Rescue -> case t of
|
||||
"" -> "in a" <+> catName c
|
||||
_ -> "in the" <+> squotes (termName t) <+> catName c
|
||||
C.RescueModifier -> "in the" <+> squotes ("rescue" <+> termName t) <+> "modifier"
|
||||
C.Modifier C.Rescue -> "in the" <+> squotes ("rescue" <+> termName t) <+> "modifier"
|
||||
C.If -> "in the" <+> squotes (termName t) <+> catName c
|
||||
C.Case -> "in the" <+> squotes (termName t) <+> catName c
|
||||
C.Break -> case t of
|
||||
@ -477,6 +479,8 @@ instance HasCategory Category where
|
||||
C.QualifiedIdentifier -> "qualified identifier"
|
||||
C.FieldDeclarations -> "field declarations"
|
||||
C.RuneLiteral -> "rune literal"
|
||||
C.Modifier C.Rescue -> "rescue modifier"
|
||||
C.Modifier c -> toCategoryName c
|
||||
|
||||
instance HasField fields Category => HasCategory (SyntaxTerm leaf fields) where
|
||||
toCategoryName = toCategoryName . category . extract
|
||||
|
||||
@ -44,19 +44,19 @@ languageForType mediaType = case mediaType of
|
||||
termConstructor
|
||||
:: Source Char -- ^ The source that the term occurs within.
|
||||
-> SourceSpan -- ^ The span that the term occupies.
|
||||
-> Text -- ^ The name of the production for this node.
|
||||
-> Category -- ^ The node’s Category.
|
||||
-> Range -- ^ The character range that the term occupies.
|
||||
-> [ SyntaxTerm Text '[Range, Category, SourceSpan] ] -- ^ The child nodes of the term.
|
||||
-> IO [ SyntaxTerm Text '[Range, Category, SourceSpan] ] -- ^ All child nodes (included unnamed productions) of the term as 'IO'. Only use this if you need it.
|
||||
-> IO (SyntaxTerm Text '[Range, Category, SourceSpan]) -- ^ The resulting term, in IO.
|
||||
termConstructor source sourceSpan name range children _ =
|
||||
withDefaultInfo $ case (name, children) of
|
||||
("ERROR", _) -> S.Error children
|
||||
termConstructor source sourceSpan category range children _ =
|
||||
withDefaultInfo $ case (category, children) of
|
||||
(Error, _) -> S.Error children
|
||||
(_, []) -> S.Leaf (toText $ slice range source)
|
||||
_ -> S.Indexed children
|
||||
where
|
||||
withDefaultInfo syntax =
|
||||
pure $! cofree ((range :. Other name :. sourceSpan :. Nil) :< syntax)
|
||||
pure $! cofree ((range :. category :. sourceSpan :. Nil) :< syntax)
|
||||
|
||||
toVarDecl :: (HasField fields Category) => Term (S.Syntax Text) (Record fields) -> Term (S.Syntax Text) (Record fields)
|
||||
toVarDecl child = cofree $ setCategory (extract child) VarDecl :< S.VarDecl child Nothing
|
||||
|
||||
@ -11,18 +11,18 @@ import Term
|
||||
termConstructor
|
||||
:: Source Char -- ^ The source that the term occurs within.
|
||||
-> SourceSpan -- ^ The span that the term occupies.
|
||||
-> Text -- ^ The name of the production for this node.
|
||||
-> Category -- ^ The node’s Category.
|
||||
-> Range -- ^ The character range that the term occupies.
|
||||
-> [ SyntaxTerm Text '[Range, Category, SourceSpan] ] -- ^ The child nodes of the term.
|
||||
-> IO [ SyntaxTerm Text '[Range, Category, SourceSpan] ] -- ^ All child nodes (included unnamed productions) of the term as 'IO'. Only use this if you need it.
|
||||
-> IO (SyntaxTerm Text '[Range, Category, SourceSpan]) -- ^ The resulting term, in IO.
|
||||
termConstructor source sourceSpan name range children _
|
||||
| name == "ERROR" = withDefaultInfo (S.Error children)
|
||||
| otherwise = withDefaultInfo $ case (name, children) of
|
||||
(_, []) -> S.Leaf . toText $ slice range source
|
||||
termConstructor source sourceSpan category range children _
|
||||
| category == Error = withDefaultInfo (S.Error children)
|
||||
| otherwise = withDefaultInfo $ case children of
|
||||
[] -> S.Leaf . toText $ slice range source
|
||||
_ -> S.Indexed children
|
||||
where
|
||||
withDefaultInfo syntax = pure $! cofree ((range :. categoryForCProductionName name :. sourceSpan :. Nil) :< syntax)
|
||||
withDefaultInfo syntax = pure $! cofree ((range :. category :. sourceSpan :. Nil) :< syntax)
|
||||
|
||||
categoryForCProductionName :: Text -> Category
|
||||
categoryForCProductionName name = Other name
|
||||
categoryForCProductionName = Other
|
||||
|
||||
@ -13,134 +13,123 @@ import SourceSpan (unionSourceSpansFrom)
|
||||
termConstructor
|
||||
:: Source Char -- ^ The source that the term occurs within.
|
||||
-> SourceSpan -- ^ The span that the term occupies.
|
||||
-> Text -- ^ The name of the production for this node.
|
||||
-> Category -- ^ The node’s Category.
|
||||
-> Range -- ^ The character range that the term occupies.
|
||||
-> [ SyntaxTerm Text '[Range, Category, SourceSpan] ] -- ^ The child nodes of the term.
|
||||
-> IO [ SyntaxTerm Text '[Range, Category, SourceSpan] ] -- ^ All child nodes (included unnamed productions) of the term as 'IO'. Only use this if you need it.
|
||||
-> IO (SyntaxTerm Text '[Range, Category, SourceSpan]) -- ^ The resulting term, in IO.
|
||||
termConstructor source sourceSpan name range children _ = case name of
|
||||
"return_statement" -> withDefaultInfo $ S.Return children
|
||||
"source_file" -> case Prologue.break (\node -> category (extract node) == Other "package_clause") children of
|
||||
termConstructor source sourceSpan category range children _ = pure $! case category of
|
||||
Return -> withDefaultInfo $ S.Return children
|
||||
Module -> case Prologue.break (\node -> Info.category (extract node) == Other "package_clause") children of
|
||||
(comments, packageName : rest) -> case unwrap packageName of
|
||||
S.Indexed [id] -> do
|
||||
module' <- withCategory Module (S.Module id rest)
|
||||
withCategory Program (S.Indexed (comments <> [module']))
|
||||
S.Indexed [id] ->
|
||||
let module' = withCategory Module (S.Module id rest)
|
||||
in withCategory Program (S.Indexed (comments <> [module']))
|
||||
_ -> withRanges range Error children (S.Error children)
|
||||
_ -> withRanges range Error children (S.Error children)
|
||||
"import_declaration" -> toImports children
|
||||
"function_declaration" -> withDefaultInfo $ case children of
|
||||
Other "import_declaration" -> toImports children
|
||||
Function -> withDefaultInfo $ case children of
|
||||
[id, params, block] -> S.Function id (toList $ unwrap params) (toList $ unwrap block)
|
||||
rest -> S.Error rest
|
||||
"for_statement" ->
|
||||
For ->
|
||||
withDefaultInfo $ case children of
|
||||
[body] | category (extract body) == Other "block" ->
|
||||
[body] | Info.category (extract body) == Other "block" ->
|
||||
S.For [] (toList $ unwrap body)
|
||||
[forClause, body] | category (extract forClause) == Other "for_clause" ->
|
||||
[forClause, body] | Info.category (extract forClause) == Other "for_clause" ->
|
||||
S.For (toList $ unwrap forClause) (toList $ unwrap body)
|
||||
[rangeClause, body] | category (extract rangeClause) == Other "range_clause" ->
|
||||
[rangeClause, body] | Info.category (extract rangeClause) == Other "range_clause" ->
|
||||
S.For (toList $ unwrap rangeClause) (toList $ unwrap body)
|
||||
other -> S.Error other
|
||||
"type_declaration" -> toTypeDecls children
|
||||
"type_spec" -> toTypeDecl children
|
||||
"struct_type" -> toStructTy children
|
||||
"field_declaration" -> toFieldDecl children
|
||||
"expression_switch_statement" ->
|
||||
TypeDecl -> toTypeDecl children
|
||||
StructTy -> toStructTy children
|
||||
FieldDecl -> toFieldDecl children
|
||||
Switch ->
|
||||
case Prologue.break isCaseClause children of
|
||||
(clauses, cases) -> do
|
||||
clauses' <- case clauses of
|
||||
[] -> pure Nothing
|
||||
clauses'' -> Just <$> (withCategory ExpressionStatements (S.Indexed clauses''))
|
||||
cases' <- sequenceA $ toCase <$> cases
|
||||
withDefaultInfo $ S.Switch clauses' cases'
|
||||
(clauses, cases) -> withDefaultInfo $ case clauses of
|
||||
[id] -> S.Switch (Just id) cases -- type_switch_statement
|
||||
[] -> S.Switch Nothing (toCase <$> cases)
|
||||
_ -> S.Switch (Just (withCategory ExpressionStatements (S.Indexed clauses))) (toCase <$> cases)
|
||||
where
|
||||
isCaseClause = (== Other "expression_case_clause") . category . extract
|
||||
isCaseClause = (== Case) . Info.category . extract
|
||||
toCase clause = case toList (unwrap clause) of
|
||||
clause' : rest -> case toList (unwrap clause') of
|
||||
[clause''] -> withCategory Case $ S.Case clause'' rest
|
||||
[] -> withCategory DefaultCase $ S.DefaultCase rest
|
||||
rest -> withCategory Error $ S.Error rest
|
||||
[] -> withCategory Error $ S.Error [clause]
|
||||
"parameter_declaration" -> withDefaultInfo $ case children of
|
||||
ParameterDecl -> withDefaultInfo $ case children of
|
||||
[param, ty] -> S.ParameterDecl (Just ty) param
|
||||
[param] -> S.ParameterDecl Nothing param
|
||||
_ -> S.Error children
|
||||
"assignment_statement" -> toVarAssignment children
|
||||
"type_switch_statement" ->
|
||||
case Prologue.break isCaseClause children of
|
||||
(clauses, cases) ->
|
||||
withDefaultInfo $ case clauses of
|
||||
[id] -> S.Switch (Just id) cases
|
||||
_ -> S.Error children
|
||||
where isCaseClause = (== Case) . category . extract
|
||||
"select_statement" -> withDefaultInfo $ S.Select (toCommunicationCase =<< children)
|
||||
Assignment -> toVarAssignment children
|
||||
Select -> withDefaultInfo $ S.Select (toCommunicationCase =<< children)
|
||||
where toCommunicationCase = toList . unwrap
|
||||
"go_statement" -> withDefaultInfo $ toExpression S.Go children
|
||||
"defer_statement" -> withDefaultInfo $ toExpression S.Defer children
|
||||
"selector_expression" -> withDefaultInfo $ toSubscriptAccess children
|
||||
"index_expression" -> withDefaultInfo $ toSubscriptAccess children
|
||||
"slice_expression" -> sliceToSubscriptAccess children
|
||||
"composite_literal" -> toLiteral children
|
||||
"type_assertion_expression" -> withDefaultInfo $ case children of
|
||||
Go -> withDefaultInfo $ toExpression S.Go children
|
||||
Defer -> withDefaultInfo $ toExpression S.Defer children
|
||||
SubscriptAccess -> withDefaultInfo $ toSubscriptAccess children
|
||||
IndexExpression -> withDefaultInfo $ toSubscriptAccess children
|
||||
Slice -> sliceToSubscriptAccess children
|
||||
Other "composite_literal" -> toLiteral children
|
||||
TypeAssertion -> withDefaultInfo $ case children of
|
||||
[a, b] -> S.TypeAssertion a b
|
||||
rest -> S.Error rest
|
||||
"type_conversion_expression" -> withDefaultInfo $ case children of
|
||||
TypeConversion -> withDefaultInfo $ case children of
|
||||
[a, b] -> S.TypeConversion a b
|
||||
rest -> S.Error rest
|
||||
-- TODO: Handle multiple var specs
|
||||
"var_declaration" -> toVarDecls children
|
||||
"var_spec" -> toVarAssignment children
|
||||
"short_var_declaration" -> toVarAssignment children
|
||||
"if_statement" -> toIfStatement children
|
||||
"call_expression" -> withDefaultInfo $ case children of
|
||||
Other "var_declaration" -> toVarDecls children
|
||||
VarAssignment -> toVarAssignment children
|
||||
VarDecl -> toVarAssignment children
|
||||
If -> toIfStatement children
|
||||
FunctionCall -> withDefaultInfo $ case children of
|
||||
[id] -> S.FunctionCall id []
|
||||
id : rest -> S.FunctionCall id rest
|
||||
rest -> S.Error rest
|
||||
"const_declaration" -> toConsts children
|
||||
"const_spec" -> toVarAssignment children
|
||||
"func_literal" -> withDefaultInfo $ case children of
|
||||
Other "const_declaration" -> toConsts children
|
||||
AnonymousFunction -> withDefaultInfo $ case children of
|
||||
[params, _, body] -> case toList (unwrap params) of
|
||||
[params'] -> S.AnonymousFunction (toList $ unwrap params') (toList $ unwrap body)
|
||||
rest -> S.Error rest
|
||||
rest -> S.Error rest
|
||||
"pointer_type" -> withDefaultInfo $ case children of
|
||||
PointerTy -> withDefaultInfo $ case children of
|
||||
[ty] -> S.Ty ty
|
||||
rest -> S.Error rest
|
||||
"channel_type" -> withDefaultInfo $ case children of
|
||||
ChannelTy -> withDefaultInfo $ case children of
|
||||
[ty] -> S.Ty ty
|
||||
rest -> S.Error rest
|
||||
"send_statement" -> withDefaultInfo $ case children of
|
||||
Send -> withDefaultInfo $ case children of
|
||||
[channel, expr] -> S.Send channel expr
|
||||
rest -> S.Error rest
|
||||
"unary_expression" -> withDefaultInfo $ S.Operator children
|
||||
"function_type" -> do
|
||||
params <- withRanges range Params children $ S.Indexed children
|
||||
withDefaultInfo $ S.Ty params
|
||||
"inc_statement" -> do
|
||||
Operator -> withDefaultInfo $ S.Operator children
|
||||
FunctionTy ->
|
||||
let params = withRanges range Params children $ S.Indexed children
|
||||
in withDefaultInfo $ S.Ty params
|
||||
IncrementStatement ->
|
||||
withDefaultInfo $ S.Leaf . toText $ slice range source
|
||||
"dec_statement" -> do
|
||||
DecrementStatement ->
|
||||
withDefaultInfo $ S.Leaf . toText $ slice range source
|
||||
"qualified_identifier" -> do
|
||||
QualifiedIdentifier ->
|
||||
withDefaultInfo $ S.Leaf . toText $ slice range source
|
||||
"break_statement" -> toBreak children
|
||||
"continue_statement" -> toContinue children
|
||||
"keyed_element" -> toPair children
|
||||
"method_declaration" -> toMethod children
|
||||
Break -> toBreak children
|
||||
Continue -> toContinue children
|
||||
Pair -> toPair children
|
||||
Method -> toMethod children
|
||||
_ -> withDefaultInfo $ case children of
|
||||
[] -> S.Leaf . toText $ slice range source
|
||||
_ -> S.Indexed children
|
||||
where
|
||||
toMethod = \case
|
||||
[params, name, fun] -> withDefaultInfo (S.Method name Nothing (toList $ unwrap params) (toList $ unwrap fun))
|
||||
[params, name, outParams, fun] -> do
|
||||
[params, name, outParams, fun] ->
|
||||
let params' = toList (unwrap params)
|
||||
outParams' = toList (unwrap outParams)
|
||||
allParams = params' <> outParams'
|
||||
withDefaultInfo (S.Method name Nothing allParams (toList $ unwrap fun))
|
||||
[params, name, outParams, ty, fun] -> do
|
||||
in withDefaultInfo (S.Method name Nothing allParams (toList $ unwrap fun))
|
||||
[params, name, outParams, ty, fun] ->
|
||||
let params' = toList (unwrap params)
|
||||
outParams' = toList (unwrap outParams)
|
||||
allParams = params' <> outParams'
|
||||
withDefaultInfo (S.Method name (Just ty) allParams (toList $ unwrap fun))
|
||||
in withDefaultInfo (S.Method name (Just ty) allParams (toList $ unwrap fun))
|
||||
rest -> withCategory Error (S.Error rest)
|
||||
toPair = \case
|
||||
[key, value] -> withDefaultInfo (S.Pair key value)
|
||||
@ -154,12 +143,11 @@ termConstructor source sourceSpan name range children _ = case name of
|
||||
[] -> withDefaultInfo (S.Continue Nothing)
|
||||
rest -> withCategory Error (S.Error rest)
|
||||
|
||||
toStructTy children = do
|
||||
fields <- withRanges range FieldDeclarations children (S.Indexed children)
|
||||
withDefaultInfo (S.Ty fields)
|
||||
toStructTy children =
|
||||
withDefaultInfo (S.Ty (withRanges range FieldDeclarations children (S.Indexed children)))
|
||||
|
||||
toLiteral = \case
|
||||
children@[ty, _] -> case category (extract ty) of
|
||||
children@[ty, _] -> case Info.category (extract ty) of
|
||||
ArrayTy -> toImplicitArray children
|
||||
DictionaryTy -> toMap children
|
||||
SliceTy -> sliceToSubscriptAccess children
|
||||
@ -177,22 +165,19 @@ termConstructor source sourceSpan name range children _ = case name of
|
||||
[ty, values] -> withCategory Struct (S.Struct (Just ty) (toList $ unwrap values))
|
||||
rest -> withRanges range Error rest $ S.Error rest
|
||||
toFieldDecl = \case
|
||||
[idList, ty] -> do
|
||||
ident' <- toIdent (toList $ unwrap idList)
|
||||
case category (extract ty) of
|
||||
StringLiteral -> withCategory FieldDecl (S.FieldDecl ident' Nothing (Just ty))
|
||||
_ -> withCategory FieldDecl (S.FieldDecl ident' (Just ty) Nothing)
|
||||
[idList] -> do
|
||||
ident' <- toIdent (toList $ unwrap idList)
|
||||
withCategory FieldDecl (S.FieldDecl ident' Nothing Nothing)
|
||||
[idList, ty, tag] -> do
|
||||
ident' <- toIdent (toList $ unwrap idList)
|
||||
withCategory FieldDecl (S.FieldDecl ident' (Just ty) (Just tag))
|
||||
[idList, ty] ->
|
||||
case Info.category (extract ty) of
|
||||
StringLiteral -> withCategory FieldDecl (S.FieldDecl (toIdent (toList (unwrap idList))) Nothing (Just ty))
|
||||
_ -> withCategory FieldDecl (S.FieldDecl (toIdent (toList (unwrap idList))) (Just ty) Nothing)
|
||||
[idList] ->
|
||||
withCategory FieldDecl (S.FieldDecl (toIdent (toList (unwrap idList))) Nothing Nothing)
|
||||
[idList, ty, tag] ->
|
||||
withCategory FieldDecl (S.FieldDecl (toIdent (toList (unwrap idList))) (Just ty) (Just tag))
|
||||
rest -> withRanges range Error rest (S.Error rest)
|
||||
|
||||
where
|
||||
toIdent = \case
|
||||
[ident] -> pure ident
|
||||
[ident] -> ident
|
||||
rest -> withRanges range Error rest (S.Error rest)
|
||||
|
||||
|
||||
@ -203,50 +188,47 @@ termConstructor source sourceSpan name range children _ = case name of
|
||||
[a, b] -> S.SubscriptAccess a b
|
||||
rest -> S.Error rest
|
||||
sliceToSubscriptAccess = \case
|
||||
a : rest -> do
|
||||
sliceElement <- withRanges range Element rest $ S.Fixed rest
|
||||
withCategory Slice (S.SubscriptAccess a sliceElement)
|
||||
a : rest ->
|
||||
let sliceElement = withRanges range Element rest $ S.Fixed rest
|
||||
in withCategory Slice (S.SubscriptAccess a sliceElement)
|
||||
rest -> withRanges range Error rest $ S.Error rest
|
||||
|
||||
toIfStatement children = case Prologue.break ((Other "block" ==) . category . extract) children of
|
||||
(clauses, blocks) -> do
|
||||
clauses' <- withRanges range ExpressionStatements clauses (S.Indexed clauses)
|
||||
let blocks' = foldMap (toList . unwrap) blocks
|
||||
withDefaultInfo (S.If clauses' blocks')
|
||||
|
||||
toTypeDecls types = withDefaultInfo $ S.Indexed types
|
||||
toIfStatement children = case Prologue.break ((Other "block" ==) . Info.category . extract) children of
|
||||
(clauses, blocks) ->
|
||||
let clauses' = withRanges range ExpressionStatements clauses (S.Indexed clauses)
|
||||
blocks' = foldMap (toList . unwrap) blocks
|
||||
in withDefaultInfo (S.If clauses' blocks')
|
||||
|
||||
toTypeDecl = \case
|
||||
[identifier, ty] -> withDefaultInfo $ S.TypeDecl identifier ty
|
||||
rest -> withRanges range Error rest $ S.Error rest
|
||||
|
||||
toImports imports = do
|
||||
imports' <- mapM toImport imports
|
||||
withDefaultInfo $ S.Indexed (mconcat imports')
|
||||
toImports imports =
|
||||
withDefaultInfo $ S.Indexed (imports >>= toImport)
|
||||
where
|
||||
toImport i = case toList (unwrap i) of
|
||||
[importName] -> sequenceA [ withCategory Import (S.Import importName []) ]
|
||||
rest@(_:_) -> sequenceA [ withRanges range Error rest (S.Error rest)]
|
||||
[] -> pure []
|
||||
[importName] -> [ withCategory Import (S.Import importName []) ]
|
||||
rest@(_:_) -> [ withRanges range Error rest (S.Error rest)]
|
||||
[] -> []
|
||||
|
||||
toVarDecls children = withDefaultInfo (S.Indexed children)
|
||||
|
||||
toConsts constSpecs = withDefaultInfo (S.Indexed constSpecs)
|
||||
|
||||
toVarAssignment = \case
|
||||
[idList, ty] | category (extract ty) == Identifier -> do
|
||||
[idList, ty] | Info.category (extract ty) == Identifier ->
|
||||
let ids = toList (unwrap idList)
|
||||
idList' <- mapM (\id -> withRanges range VarDecl [id] (S.VarDecl id (Just ty))) ids
|
||||
withRanges range ExpressionStatements idList' (S.Indexed idList')
|
||||
[idList, expressionList] | category (extract expressionList) == Other "expression_list" -> do
|
||||
assignments' <- sequenceA $ zipWith (\id expr ->
|
||||
withCategory VarAssignment $ S.VarAssignment id expr)
|
||||
(toList $ unwrap idList) (toList $ unwrap expressionList)
|
||||
withRanges range ExpressionStatements assignments' (S.Indexed assignments')
|
||||
[idList, _, expressionList] -> do
|
||||
assignments' <- sequenceA $ zipWith (\id expr ->
|
||||
withCategory VarAssignment $ S.VarAssignment id expr) (toList $ unwrap idList) (toList $ unwrap expressionList)
|
||||
withRanges range ExpressionStatements assignments' (S.Indexed assignments')
|
||||
idList' = (\id -> withRanges range VarDecl [id] (S.VarDecl id (Just ty))) <$> ids
|
||||
in withRanges range ExpressionStatements idList' (S.Indexed idList')
|
||||
[idList, expressionList] | Info.category (extract expressionList) == Other "expression_list" ->
|
||||
let assignments' = zipWith (\id expr ->
|
||||
withCategory VarAssignment $ S.VarAssignment id expr)
|
||||
(toList $ unwrap idList) (toList $ unwrap expressionList)
|
||||
in withRanges range ExpressionStatements assignments' (S.Indexed assignments')
|
||||
[idList, _, expressionList] ->
|
||||
let assignments' = zipWith (\id expr ->
|
||||
withCategory VarAssignment $ S.VarAssignment id expr) (toList $ unwrap idList) (toList $ unwrap expressionList)
|
||||
in withRanges range ExpressionStatements assignments' (S.Indexed assignments')
|
||||
[idList] -> withDefaultInfo (S.Indexed [idList])
|
||||
rest -> withRanges range Error rest (S.Error rest)
|
||||
|
||||
@ -254,12 +236,12 @@ termConstructor source sourceSpan name range children _ = case name of
|
||||
let ranges' = getField . extract <$> terms
|
||||
sourceSpans' = getField . extract <$> terms
|
||||
in
|
||||
pure $! cofree ((unionRangesFrom originalRange ranges' :. category' :. unionSourceSpansFrom sourceSpan sourceSpans' :. Nil) :< syntax)
|
||||
cofree ((unionRangesFrom originalRange ranges' :. category' :. unionSourceSpansFrom sourceSpan sourceSpans' :. Nil) :< syntax)
|
||||
|
||||
withCategory category syntax =
|
||||
pure $! cofree ((range :. category :. sourceSpan :. Nil) :< syntax)
|
||||
cofree ((range :. category :. sourceSpan :. Nil) :< syntax)
|
||||
|
||||
withDefaultInfo = withCategory (categoryForGoName name)
|
||||
withDefaultInfo = withCategory category
|
||||
|
||||
categoryForGoName :: Text -> Category
|
||||
categoryForGoName = \case
|
||||
@ -287,6 +269,7 @@ categoryForGoName = \case
|
||||
"for_statement" -> For
|
||||
"expression_switch_statement" -> Switch
|
||||
"type_switch_statement" -> Switch
|
||||
"expression_case_clause" -> Case
|
||||
"type_case_clause" -> Case
|
||||
"select_statement" -> Select
|
||||
"communication_case" -> Case
|
||||
@ -302,7 +285,6 @@ categoryForGoName = \case
|
||||
"parameter_declaration" -> ParameterDecl
|
||||
"expression_case" -> Case
|
||||
"type_spec" -> TypeDecl
|
||||
"type_declaration" -> TypeDecl
|
||||
"field_declaration" -> FieldDecl
|
||||
"pointer_type" -> PointerTy
|
||||
"slice_type" -> SliceTy
|
||||
|
||||
@ -9,120 +9,104 @@ import Language
|
||||
import qualified Syntax as S
|
||||
import Term
|
||||
|
||||
operators :: [Text]
|
||||
operators = [ "op", "bool_op", "math_op", "delete_op", "type_op", "void_op", "rel_op", "bitwise_op" ]
|
||||
|
||||
functions :: [Text]
|
||||
functions = [ "arrow_function", "generator_function", "function" ]
|
||||
|
||||
forStatements :: [Text]
|
||||
forStatements = [ "for_statement", "for_of_statement", "for_in_statement", "trailing_for_statement", "trailing_for_of_statement", "trailing_for_in_statement" ]
|
||||
operators :: [Category]
|
||||
operators = [ Operator, BooleanOperator, MathOperator, RelationalOperator, BitwiseOperator ]
|
||||
|
||||
termConstructor
|
||||
:: Source Char -- ^ The source that the term occurs within.
|
||||
-> SourceSpan -- ^ The span that the term occupies.
|
||||
-> Text -- ^ The name of the production for this node.
|
||||
-> Category -- ^ The node’s Category.
|
||||
-> Range -- ^ The character range that the term occupies.
|
||||
-> [ SyntaxTerm Text '[Range, Category, SourceSpan] ] -- ^ The child nodes of the term.
|
||||
-> IO [ SyntaxTerm Text '[Range, Category, SourceSpan] ] -- ^ All child nodes (included unnamed productions) of the term as 'IO'. Only use this if you need it.
|
||||
-> IO (SyntaxTerm Text '[Range, Category, SourceSpan]) -- ^ The resulting term, in IO.
|
||||
termConstructor source sourceSpan name range children allChildren
|
||||
| name == "ERROR" = withDefaultInfo (S.Error children)
|
||||
| name `elem` operators = do
|
||||
termConstructor source sourceSpan category range children allChildren
|
||||
| category == Error = withDefaultInfo (S.Error children)
|
||||
| category `elem` operators = do
|
||||
allChildren' <- allChildren
|
||||
withDefaultInfo $ S.Operator allChildren'
|
||||
| otherwise = withDefaultInfo $ case (name, children) of
|
||||
("return_statement", _) -> S.Return children
|
||||
("trailing_return_statement", _) -> S.Return children
|
||||
("assignment", [ identifier, value ]) -> S.Assignment identifier value
|
||||
("assignment", _ ) -> S.Error children
|
||||
("math_assignment", [ identifier, value ]) -> S.OperatorAssignment identifier value
|
||||
("math_assignment", _ ) -> S.Error children
|
||||
("member_access", [ base, property ]) -> S.MemberAccess base property
|
||||
("member_access", _ ) -> S.Error children
|
||||
("subscript_access", [ base, element ]) -> S.SubscriptAccess base element
|
||||
("subscript_access", _ ) -> S.Error children
|
||||
("comma_op", [ a, b ]) -> case unwrap b of
|
||||
| otherwise = withDefaultInfo $ case (category, children) of
|
||||
(Return, _) -> S.Return children
|
||||
(Assignment, [ identifier, value ]) -> S.Assignment identifier value
|
||||
(Assignment, _ ) -> S.Error children
|
||||
(MathAssignment, [ identifier, value ]) -> S.OperatorAssignment identifier value
|
||||
(MathAssignment, _ ) -> S.Error children
|
||||
(MemberAccess, [ base, property ]) -> S.MemberAccess base property
|
||||
(MemberAccess, _ ) -> S.Error children
|
||||
(SubscriptAccess, [ base, element ]) -> S.SubscriptAccess base element
|
||||
(SubscriptAccess, _ ) -> S.Error children
|
||||
(CommaOperator, [ a, b ]) -> case unwrap b of
|
||||
S.Indexed rest -> S.Indexed $ a : rest
|
||||
_ -> S.Indexed children
|
||||
("comma_op", _ ) -> S.Error children
|
||||
("function_call", _) -> case children of
|
||||
member : args | category (extract member) == MemberAccess -> case toList (unwrap member) of
|
||||
(CommaOperator, _ ) -> S.Error children
|
||||
(FunctionCall, _) -> case children of
|
||||
member : args | Info.category (extract member) == MemberAccess -> case toList (unwrap member) of
|
||||
[target, method] -> S.MethodCall target method (toList . unwrap =<< args)
|
||||
_ -> S.Error children
|
||||
function : args -> S.FunctionCall function (toList . unwrap =<< args)
|
||||
_ -> S.Error children
|
||||
("ternary", condition : cases) -> S.Ternary condition cases
|
||||
("ternary", _ ) -> S.Error children
|
||||
("var_assignment", [ x, y ]) -> S.VarAssignment x y
|
||||
("var_assignment", _ ) -> S.Error children
|
||||
("var_declaration", _) -> S.Indexed $ toVarDecl <$> children
|
||||
("trailing_var_declaration", _) -> S.Indexed $ toVarDecl <$> children
|
||||
("switch_statement", expr : rest) -> S.Switch (Just expr) rest
|
||||
("switch_statement", _ ) -> S.Error children
|
||||
("case", [ expr, body ]) -> S.Case expr [body]
|
||||
("case", _ ) -> S.Error children
|
||||
("object", _) -> S.Object Nothing $ foldMap toTuple children
|
||||
("pair", _) -> S.Fixed children
|
||||
("comment", _) -> S.Comment . toText $ slice range source
|
||||
("if_statement", expr : rest ) -> S.If expr rest
|
||||
("trailing_if_statement", expr : rest ) -> S.If expr rest
|
||||
("if_statement", _ ) -> S.Error children
|
||||
("trailing_if_statement", _ ) -> S.Error children
|
||||
("while_statement", expr : rest ) -> S.While expr rest
|
||||
("trailing_while_statement", expr : rest ) -> S.While expr rest
|
||||
("while_statement", _ ) -> S.Error children
|
||||
("trailing_while_statement", _ ) -> S.Error children
|
||||
("do_statement", [ expr, body ]) -> S.DoWhile expr body
|
||||
("trailing_do_statement", [ expr, body ]) -> S.DoWhile expr body
|
||||
("do_statement", _ ) -> S.Error children
|
||||
("trailing_do_statement", _ ) -> S.Error children
|
||||
("throw_statement", [ expr ]) -> S.Throw expr
|
||||
("trailing_throw_statement", [ expr ]) -> S.Throw expr
|
||||
("throw_statment", _ ) -> S.Error children
|
||||
("trailing_throw_statment", _ ) -> S.Error children
|
||||
("new_expression", [ expr ]) -> S.Constructor expr
|
||||
("new_expression", _ ) -> S.Error children
|
||||
("try_statement", _) -> case children of
|
||||
(Ternary, condition : cases) -> S.Ternary condition cases
|
||||
(Ternary, _ ) -> S.Error children
|
||||
(VarAssignment, [ x, y ]) -> S.VarAssignment x y
|
||||
(VarAssignment, _ ) -> S.Error children
|
||||
(VarDecl, _) -> S.Indexed $ toVarDecl <$> children
|
||||
(Switch, expr : rest) -> S.Switch (Just expr) rest
|
||||
(Switch, _ ) -> S.Error children
|
||||
(Case, [ expr, body ]) -> S.Case expr [body]
|
||||
(Case, _ ) -> S.Error children
|
||||
(Object, _) -> S.Object Nothing $ foldMap toTuple children
|
||||
(Pair, _) -> S.Fixed children
|
||||
(Comment, _) -> S.Comment . toText $ slice range source
|
||||
(If, expr : rest ) -> S.If expr rest
|
||||
(If, _ ) -> S.Error children
|
||||
(While, expr : rest ) -> S.While expr rest
|
||||
(While, _ ) -> S.Error children
|
||||
(DoWhile, [ expr, body ]) -> S.DoWhile expr body
|
||||
(DoWhile, _ ) -> S.Error children
|
||||
(Throw, [ expr ]) -> S.Throw expr
|
||||
(Throw, _ ) -> S.Error children
|
||||
(Constructor, [ expr ]) -> S.Constructor expr
|
||||
(Constructor, _ ) -> S.Error children
|
||||
(Try, _) -> case children of
|
||||
[ body ] -> S.Try [body] [] Nothing Nothing
|
||||
[ body, catch ] | Catch <- category (extract catch) -> S.Try [body] [catch] Nothing Nothing
|
||||
[ body, finally ] | Finally <- category (extract finally) -> S.Try [body] [] Nothing (Just finally)
|
||||
[ body, catch ] | Catch <- Info.category (extract catch) -> S.Try [body] [catch] Nothing Nothing
|
||||
[ body, finally ] | Finally <- Info.category (extract finally) -> S.Try [body] [] Nothing (Just finally)
|
||||
[ body, catch, finally ]
|
||||
| Catch <- category (extract catch)
|
||||
, Finally <- category (extract finally) -> S.Try [body] [catch] Nothing (Just finally)
|
||||
| Catch <- Info.category (extract catch)
|
||||
, Finally <- Info.category (extract finally) -> S.Try [body] [catch] Nothing (Just finally)
|
||||
_ -> S.Error children
|
||||
("array", _) -> S.Array Nothing children
|
||||
("method_definition", [ identifier, params, exprs ]) -> S.Method identifier Nothing (toList (unwrap params)) (toList (unwrap exprs))
|
||||
("method_definition", [ identifier, exprs ]) -> S.Method identifier Nothing [] (toList (unwrap exprs))
|
||||
("method_definition", _ ) -> S.Error children
|
||||
("class", [ identifier, superclass, definitions ]) -> S.Class identifier (Just superclass) (toList (unwrap definitions))
|
||||
("class", [ identifier, definitions ]) -> S.Class identifier Nothing (toList (unwrap definitions))
|
||||
("class", _ ) -> S.Error children
|
||||
("import_statement", [ statements, identifier ] ) -> S.Import identifier (toList (unwrap statements))
|
||||
("import_statement", [ identifier ] ) -> S.Import identifier []
|
||||
("import_statement", _ ) -> S.Error children
|
||||
("export_statement", [ statements, identifier] ) -> S.Export (Just identifier) (toList (unwrap statements))
|
||||
("export_statement", [ statements ] ) -> case unwrap statements of
|
||||
(ArrayLiteral, _) -> S.Array Nothing children
|
||||
(Method, [ identifier, params, exprs ]) -> S.Method identifier Nothing (toList (unwrap params)) (toList (unwrap exprs))
|
||||
(Method, [ identifier, exprs ]) -> S.Method identifier Nothing [] (toList (unwrap exprs))
|
||||
(Method, _ ) -> S.Error children
|
||||
(Class, [ identifier, superclass, definitions ]) -> S.Class identifier (Just superclass) (toList (unwrap definitions))
|
||||
(Class, [ identifier, definitions ]) -> S.Class identifier Nothing (toList (unwrap definitions))
|
||||
(Class, _ ) -> S.Error children
|
||||
(Import, [ statements, identifier ] ) -> S.Import identifier (toList (unwrap statements))
|
||||
(Import, [ identifier ] ) -> S.Import identifier []
|
||||
(Import, _ ) -> S.Error children
|
||||
(Export, [ statements, identifier] ) -> S.Export (Just identifier) (toList (unwrap statements))
|
||||
(Export, [ statements ] ) -> case unwrap statements of
|
||||
S.Indexed _ -> S.Export Nothing (toList (unwrap statements))
|
||||
_ -> S.Export (Just statements) []
|
||||
("export_statement", _ ) -> S.Error children
|
||||
("break_statement", [ expr ] ) -> S.Break (Just expr)
|
||||
("yield_statement", _ ) -> S.Yield children
|
||||
_ | name `elem` forStatements -> case unsnoc children of
|
||||
Just (exprs, body) -> S.For exprs [body]
|
||||
_ -> S.Error children
|
||||
_ | name `elem` functions -> case children of
|
||||
[ body ] -> S.AnonymousFunction [] [body]
|
||||
[ params, body ] -> S.AnonymousFunction (toList (unwrap params)) [body]
|
||||
[ id, params, body ] -> S.Function id (toList (unwrap params)) [body]
|
||||
_ -> S.Error children
|
||||
(Export, _ ) -> S.Error children
|
||||
(Break, [ expr ] ) -> S.Break (Just expr)
|
||||
(Yield, _ ) -> S.Yield children
|
||||
(For, _) -> case unsnoc children of
|
||||
Just (exprs, body) -> S.For exprs [body]
|
||||
_ -> S.Error children
|
||||
(Function, _) -> case children of
|
||||
[ body ] -> S.AnonymousFunction [] [body]
|
||||
[ params, body ] -> S.AnonymousFunction (toList (unwrap params)) [body]
|
||||
[ id, params, body ] -> S.Function id (toList (unwrap params)) [body]
|
||||
_ -> S.Error children
|
||||
(_, []) -> S.Leaf . toText $ slice range source
|
||||
_ -> S.Indexed children
|
||||
where
|
||||
withDefaultInfo syntax =
|
||||
pure $! case syntax of
|
||||
S.MethodCall{} -> cofree ((range :. MethodCall :. sourceSpan :. Nil) :< syntax)
|
||||
_ -> cofree ((range :. categoryForJavaScriptProductionName name :. sourceSpan :. Nil) :< syntax)
|
||||
_ -> cofree ((range :. category :. sourceSpan :. Nil) :< syntax)
|
||||
|
||||
categoryForJavaScriptProductionName :: Text -> Category
|
||||
categoryForJavaScriptProductionName name = case name of
|
||||
|
||||
@ -10,136 +10,124 @@ import Language
|
||||
import qualified Syntax as S
|
||||
import Term
|
||||
|
||||
operators :: [Text]
|
||||
operators = ["binary", "unary", "range", "scope_resolution"]
|
||||
operators :: [Category]
|
||||
operators = [ Binary, Unary, RangeExpression, ScopeOperator ]
|
||||
|
||||
termConstructor
|
||||
:: Source Char -- ^ The source that the term occurs within.
|
||||
-> SourceSpan -- ^ The span that the term occupies.
|
||||
-> Text -- ^ The name of the production for this node.
|
||||
-> Category -- ^ The node’s Category.
|
||||
-> Range -- ^ The character range that the term occupies.
|
||||
-> [ SyntaxTerm Text '[Range, Category, SourceSpan] ] -- ^ The child nodes of the term.
|
||||
-> IO [ SyntaxTerm Text '[Range, Category, SourceSpan] ] -- ^ All child nodes (included unnamed productions) of the term as 'IO'. Only use this if you need it.
|
||||
-> IO (SyntaxTerm Text '[Range, Category, SourceSpan]) -- ^ The resulting term, in IO.
|
||||
termConstructor source sourceSpan name range children allChildren
|
||||
| name == "ERROR" = withDefaultInfo (S.Error children)
|
||||
| name == "unless_modifier" = case children of
|
||||
[ lhs, rhs ] -> do
|
||||
condition <- withRecord (setCategory (extract rhs) Negate) (S.Negate rhs)
|
||||
withDefaultInfo $ S.If condition [lhs]
|
||||
_ -> withDefaultInfo $ S.Error children
|
||||
| name == "unless" = case children of
|
||||
( expr : rest ) -> do
|
||||
condition <- withRecord (setCategory (extract expr) Negate) (S.Negate expr)
|
||||
withDefaultInfo $ S.If condition rest
|
||||
_ -> withDefaultInfo $ S.Error children
|
||||
| name == "until_modifier" = case children of
|
||||
[ lhs, rhs ] -> do
|
||||
condition <- withRecord (setCategory (extract rhs) Negate) (S.Negate rhs)
|
||||
withDefaultInfo $ S.While condition [lhs]
|
||||
_ -> withDefaultInfo $ S.Error children
|
||||
| name == "until" = case children of
|
||||
( expr : rest ) -> do
|
||||
condition <- withRecord (setCategory (extract expr) Negate) (S.Negate expr)
|
||||
withDefaultInfo $ S.While condition rest
|
||||
_ -> withDefaultInfo $ S.Error children
|
||||
| name `elem` operators = do
|
||||
termConstructor source sourceSpan category range children allChildren
|
||||
| category == Error = pure $! withDefaultInfo (S.Error children)
|
||||
| category `elem` operators = do
|
||||
allChildren' <- allChildren
|
||||
withDefaultInfo $ S.Operator allChildren'
|
||||
| otherwise = withDefaultInfo $ case (name, children) of
|
||||
("argument_pair", [ k, v ] ) -> S.Pair k v
|
||||
("argument_pair", _ ) -> S.Error children
|
||||
("keyword_parameter", [ k, v ] ) -> S.Pair k v
|
||||
-- NB: ("keyword_parameter", k) is a required keyword parameter, e.g:.
|
||||
pure $! withDefaultInfo $ S.Operator allChildren'
|
||||
| otherwise = pure . withDefaultInfo $ case (category, children) of
|
||||
(ArgumentPair, [ k, v ] ) -> S.Pair k v
|
||||
(ArgumentPair, _ ) -> S.Error children
|
||||
(KeywordParameter, [ k, v ] ) -> 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.
|
||||
("optional_parameter", [ k, v ] ) -> S.Pair k v
|
||||
("optional_parameter", _ ) -> S.Error children
|
||||
("array", _ ) -> S.Array Nothing children
|
||||
("assignment", [ identifier, value ]) -> S.Assignment identifier value
|
||||
("assignment", _ ) -> S.Error children
|
||||
("begin", _ ) -> case partition (\x -> category (extract x) == Rescue) children of
|
||||
(rescues, rest) -> case partition (\x -> category (extract x) == Ensure || category (extract x) == Else) rest of
|
||||
(OptionalParameter, [ k, v ] ) -> S.Pair k v
|
||||
(OptionalParameter, _ ) -> S.Error children
|
||||
(ArrayLiteral, _ ) -> S.Array Nothing children
|
||||
(Assignment, [ identifier, value ]) -> S.Assignment identifier value
|
||||
(Assignment, _ ) -> S.Error children
|
||||
(Begin, _ ) -> 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 <- category (extract elseBlock)
|
||||
, Ensure <- category (extract ensure) -> S.Try body rescues (Just elseBlock) (Just ensure)
|
||||
| Else <- Info.category (extract elseBlock)
|
||||
, Ensure <- Info.category (extract ensure) -> S.Try body rescues (Just elseBlock) (Just ensure)
|
||||
[ ensure, elseBlock ]
|
||||
| Ensure <- category (extract ensure)
|
||||
, Else <- category (extract elseBlock) -> S.Try body rescues (Just elseBlock) (Just ensure)
|
||||
[ elseBlock ] | Else <- category (extract elseBlock) -> S.Try body rescues (Just elseBlock) Nothing
|
||||
[ ensure ] | Ensure <- category (extract ensure) -> S.Try body rescues Nothing (Just ensure)
|
||||
| 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
|
||||
("case", expr : body ) -> S.Switch (Just expr) body
|
||||
("case", _ ) -> S.Error children
|
||||
("when", condition : body ) -> S.Case condition body
|
||||
("when", _ ) -> S.Error children
|
||||
("class", constant : rest ) -> case rest of
|
||||
( superclass : body ) | Superclass <- category (extract superclass) -> S.Class constant (Just superclass) body
|
||||
(Case, expr : body ) -> S.Switch (Just expr) body
|
||||
(Case, _ ) -> S.Error children
|
||||
(When, condition : body ) -> S.Case condition body
|
||||
(When, _ ) -> S.Error children
|
||||
(Class, constant : rest ) -> case rest of
|
||||
( superclass : body ) | Superclass <- Info.category (extract superclass) -> S.Class constant (Just superclass) body
|
||||
_ -> S.Class constant Nothing rest
|
||||
("class", _ ) -> S.Error children
|
||||
("singleton_class", identifier : rest ) -> S.Class identifier Nothing rest
|
||||
("singleton_class", _ ) -> S.Error children
|
||||
("comment", _ ) -> S.Comment . toText $ slice range source
|
||||
("conditional", condition : cases) -> S.Ternary condition cases
|
||||
("conditional", _ ) -> S.Error children
|
||||
("constant", _ ) -> S.Fixed children
|
||||
("method_call", _ ) -> case children of
|
||||
member : args | MemberAccess <- category (extract member) -> case toList (unwrap member) of
|
||||
(Class, _ ) -> S.Error children
|
||||
(SingletonClass, identifier : rest ) -> S.Class identifier Nothing rest
|
||||
(SingletonClass, _ ) -> S.Error children
|
||||
(Comment, _ ) -> S.Comment . toText $ slice range source
|
||||
(Ternary, condition : cases) -> S.Ternary condition cases
|
||||
(Ternary, _ ) -> S.Error children
|
||||
(Constant, _ ) -> S.Fixed children
|
||||
(MethodCall, _ ) -> case children of
|
||||
member : args | MemberAccess <- Info.category (extract member) -> case toList (unwrap member) of
|
||||
[target, method] -> S.MethodCall target method (toList . unwrap =<< args)
|
||||
_ -> S.Error children
|
||||
function : args -> S.FunctionCall function (toList . unwrap =<< args)
|
||||
_ -> S.Error children
|
||||
("lambda", _) -> case children of
|
||||
(Other "lambda", _) -> case children of
|
||||
[ body ] -> S.AnonymousFunction [] [body]
|
||||
( params : body ) -> S.AnonymousFunction (toList (unwrap params)) body
|
||||
_ -> S.Error children
|
||||
("hash", _ ) -> S.Object Nothing $ foldMap toTuple children
|
||||
("if_modifier", [ lhs, condition ]) -> S.If condition [lhs]
|
||||
("if_modifier", _ ) -> S.Error children
|
||||
("if", condition : body ) -> S.If condition body
|
||||
("if", _ ) -> S.Error children
|
||||
("elsif", condition : body ) -> S.If condition body
|
||||
("elsif", _ ) -> S.Error children
|
||||
("element_reference", [ base, element ]) -> S.SubscriptAccess base element
|
||||
("element_reference", _ ) -> S.Error children
|
||||
("for", lhs : expr : rest ) -> S.For [lhs, expr] rest
|
||||
("for", _ ) -> S.Error children
|
||||
("operator_assignment", [ identifier, value ]) -> S.OperatorAssignment identifier value
|
||||
("operator_assignment", _ ) -> S.Error children
|
||||
("call", [ base, property ]) -> S.MemberAccess base property
|
||||
("call", _ ) -> S.Error children
|
||||
("method", _ ) -> case children of
|
||||
identifier : params : body | Params <- category (extract params) -> S.Method identifier Nothing (toList (unwrap params)) body
|
||||
(Object, _ ) -> S.Object Nothing $ foldMap toTuple children
|
||||
(Modifier If, [ lhs, condition ]) -> S.If condition [lhs]
|
||||
(Modifier If, _) -> S.Error children
|
||||
(If, condition : body ) -> S.If condition body
|
||||
(If, _ ) -> S.Error children
|
||||
(Modifier Unless, [lhs, rhs]) -> S.If (withRecord (setCategory (extract rhs) Negate) (S.Negate rhs)) [lhs]
|
||||
(Modifier Unless, _) -> S.Error children
|
||||
(Unless, expr : rest) -> S.If (withRecord (setCategory (extract expr) Negate) (S.Negate expr)) rest
|
||||
(Unless, _) -> S.Error children
|
||||
(Modifier Until, [ lhs, rhs ]) -> S.While (withRecord (setCategory (extract rhs) Negate) (S.Negate rhs)) [lhs]
|
||||
(Modifier Until, _) -> S.Error children
|
||||
(Until, expr : rest) -> S.While (withRecord (setCategory (extract expr) Negate) (S.Negate expr)) rest
|
||||
(Until, _) -> S.Error children
|
||||
(Elsif, condition : body ) -> S.If condition body
|
||||
(Elsif, _ ) -> S.Error children
|
||||
(SubscriptAccess, [ base, element ]) -> S.SubscriptAccess base element
|
||||
(SubscriptAccess, _ ) -> S.Error children
|
||||
(For, lhs : expr : rest ) -> S.For [lhs, expr] rest
|
||||
(For, _ ) -> S.Error children
|
||||
(OperatorAssignment, [ identifier, value ]) -> S.OperatorAssignment identifier value
|
||||
(OperatorAssignment, _ ) -> S.Error children
|
||||
(MemberAccess, [ base, property ]) -> S.MemberAccess base property
|
||||
(MemberAccess, _ ) -> S.Error children
|
||||
(Method, _ ) -> case children of
|
||||
identifier : params : body | Params <- Info.category (extract params) -> S.Method identifier Nothing (toList (unwrap params)) body
|
||||
identifier : body -> S.Method identifier Nothing [] body
|
||||
_ -> S.Error children
|
||||
("module", constant : body ) -> S.Module constant body
|
||||
("module", _ ) -> S.Error children
|
||||
("rescue", _ ) -> case children of
|
||||
(Module, constant : body ) -> S.Module constant body
|
||||
(Module, _ ) -> S.Error children
|
||||
(Modifier Rescue, [lhs, rhs] ) -> S.Rescue [lhs] [rhs]
|
||||
(Modifier Rescue, _) -> S.Error children
|
||||
(Rescue, _ ) -> case children of
|
||||
exceptions : exceptionVar : rest
|
||||
| RescueArgs <- category (extract exceptions)
|
||||
, RescuedException <- category (extract exceptionVar) -> S.Rescue (toList (unwrap exceptions) <> [exceptionVar]) rest
|
||||
exceptionVar : rest | RescuedException <- category (extract exceptionVar) -> S.Rescue [exceptionVar] rest
|
||||
exceptions : body | RescueArgs <- category (extract exceptions) -> S.Rescue (toList (unwrap exceptions)) body
|
||||
| RescueArgs <- Info.category (extract exceptions)
|
||||
, RescuedException <- Info.category (extract exceptionVar) -> S.Rescue (toList (unwrap exceptions) <> [exceptionVar]) rest
|
||||
exceptionVar : rest | RescuedException <- Info.category (extract exceptionVar) -> S.Rescue [exceptionVar] rest
|
||||
exceptions : body | RescueArgs <- Info.category (extract exceptions) -> S.Rescue (toList (unwrap exceptions)) body
|
||||
body -> S.Rescue [] body
|
||||
("rescue_modifier", [lhs, rhs] ) -> S.Rescue [lhs] [rhs]
|
||||
("rescue_modifier", _ ) -> S.Error children
|
||||
("return", _ ) -> S.Return children
|
||||
("while_modifier", [ lhs, condition ]) -> S.While condition [lhs]
|
||||
("while_modifier", _ ) -> S.Error children
|
||||
("while", expr : rest ) -> S.While expr rest
|
||||
("while", _ ) -> S.Error children
|
||||
("yield", _ ) -> S.Yield children
|
||||
_ | name `elem` ["begin_block", "end_block"] -> S.BlockStatement children
|
||||
(Return, _ ) -> S.Return children
|
||||
(Modifier While, [ lhs, condition ]) -> S.While condition [lhs]
|
||||
(Modifier While, _) -> S.Error children
|
||||
(While, expr : rest ) -> S.While expr rest
|
||||
(While, _ ) -> S.Error children
|
||||
(Yield, _ ) -> S.Yield children
|
||||
_ | category `elem` [ BeginBlock, EndBlock ] -> S.BlockStatement children
|
||||
(_, []) -> S.Leaf . toText $ slice range source
|
||||
_ -> S.Indexed children
|
||||
where
|
||||
withRecord record syntax = pure $! cofree (record :< syntax)
|
||||
withRecord record syntax = cofree (record :< syntax)
|
||||
withCategory category syntax =
|
||||
pure $! cofree ((range :. category :. sourceSpan :. Nil) :< syntax)
|
||||
cofree ((range :. category :. sourceSpan :. Nil) :< syntax)
|
||||
withDefaultInfo syntax = case syntax of
|
||||
S.MethodCall{} -> withCategory MethodCall syntax
|
||||
_ -> withCategory (categoryForRubyName name) syntax
|
||||
_ -> withCategory category syntax
|
||||
|
||||
categoryForRubyName :: Text -> Category
|
||||
categoryForRubyName = \case
|
||||
@ -173,7 +161,7 @@ categoryForRubyName = \case
|
||||
"hash_splat_parameter" -> HashSplatParameter
|
||||
"hash" -> Object
|
||||
"identifier" -> Identifier
|
||||
"if_modifier" -> If
|
||||
"if_modifier" -> Modifier If
|
||||
"if" -> If
|
||||
"instance_variable" -> Identifier
|
||||
"integer" -> IntegerLiteral
|
||||
@ -189,7 +177,7 @@ categoryForRubyName = \case
|
||||
"program" -> Program
|
||||
"range" -> RangeExpression
|
||||
"regex" -> Regex
|
||||
"rescue_modifier" -> RescueModifier
|
||||
"rescue_modifier" -> Modifier Rescue
|
||||
"rescue" -> Rescue
|
||||
"return" -> Return
|
||||
"scope_resolution" -> ScopeOperator
|
||||
@ -202,12 +190,12 @@ categoryForRubyName = \case
|
||||
"symbol" -> SymbolLiteral
|
||||
"true" -> Boolean
|
||||
"unary" -> Unary
|
||||
"unless_modifier" -> Unless
|
||||
"unless_modifier" -> Modifier Unless
|
||||
"unless" -> Unless
|
||||
"until_modifier" -> Until
|
||||
"until_modifier" -> Modifier Until
|
||||
"until" -> Until
|
||||
"when" -> When
|
||||
"while_modifier" -> While
|
||||
"while_modifier" -> Modifier While
|
||||
"while" -> While
|
||||
"yield" -> Yield
|
||||
s -> Other s
|
||||
|
||||
@ -1,3 +1,5 @@
|
||||
{-# OPTIONS_GHC -Wno-deprecations #-}
|
||||
-- Disabling deprecation warnings due to pattern match against RescueModifier.
|
||||
module Renderer.Split (split) where
|
||||
|
||||
import Alignment
|
||||
@ -145,6 +147,7 @@ styleName category = "category-" <> case category of
|
||||
C.IndexExpression -> "index_expression"
|
||||
C.FieldDeclarations -> "field_declarations"
|
||||
C.RuneLiteral -> "rune_literal"
|
||||
C.Modifier c -> styleName c <> "_modifier"
|
||||
|
||||
-- | Pick the class name for a split patch.
|
||||
splitPatchToClassName :: SplitPatch a -> AttributeValue
|
||||
|
||||
@ -56,7 +56,7 @@ documentToTerm language document SourceBlob{..} = alloca $ \ root -> do
|
||||
-- Without it, we may not evaluate the value until after we’ve exited
|
||||
-- the scope that `node` was allocated within, meaning `alloca` will
|
||||
-- free it & other stack data may overwrite it.
|
||||
range `seq` sourceSpan `seq` termConstructor source sourceSpan (toS name) range children allChildren
|
||||
range `seq` sourceSpan `seq` termConstructor source sourceSpan (categoryForLanguageProductionName language (toS name)) range children allChildren
|
||||
getChild node n out = ts_node_p_named_child node n out >> toTerm out
|
||||
{-# INLINE getChild #-}
|
||||
getUnnamedChild node n out = ts_node_p_child node n out >> toTerm out
|
||||
@ -68,3 +68,11 @@ documentToTerm language document SourceBlob{..} = alloca $ \ root -> do
|
||||
Ruby -> Ruby.termConstructor
|
||||
_ -> Language.termConstructor
|
||||
isNonEmpty child = category (extract child) /= Empty
|
||||
|
||||
categoryForLanguageProductionName :: Language -> Text -> Category
|
||||
categoryForLanguageProductionName = \case
|
||||
JavaScript -> JS.categoryForJavaScriptProductionName
|
||||
C -> C.categoryForCProductionName
|
||||
Ruby -> Ruby.categoryForRubyName
|
||||
Language.Go -> Go.categoryForGoName
|
||||
_ -> Other
|
||||
|
||||
Loading…
Reference in New Issue
Block a user