mirror of
https://github.com/github/semantic.git
synced 2024-12-29 18:06:14 +03:00
Merge branch 'master' into docs-updates
This commit is contained in:
commit
a75e7646b4
@ -74,6 +74,7 @@ module Data.Syntax.Assignment
|
||||
, Error(..)
|
||||
, ErrorCause(..)
|
||||
, showError
|
||||
, showExpectation
|
||||
, assign
|
||||
, runAssignment
|
||||
, AssignmentState(..)
|
||||
@ -147,7 +148,7 @@ type AST grammar = Rose (Node grammar)
|
||||
|
||||
|
||||
-- | The result of assignment, possibly containing an error.
|
||||
data Result symbol a = Result { resultErrors :: [Error symbol], resultValue :: Maybe a }
|
||||
data Result symbol a = Result { resultError :: Maybe (Error symbol), resultValue :: Maybe a }
|
||||
deriving (Eq, Foldable, Functor, Traversable)
|
||||
|
||||
data Error symbol where
|
||||
@ -168,22 +169,24 @@ data ErrorCause symbol
|
||||
|
||||
-- | Pretty-print an Error with reference to the source where it occurred.
|
||||
showError :: Show symbol => Source.Source -> Error symbol -> ShowS
|
||||
showError source Error{..}
|
||||
= withSGRCode [SetConsoleIntensity BoldIntensity] (showSourcePos Nothing errorPos) . showString ": " . withSGRCode [SetColor Foreground Vivid Red] (showString "error") . showString ": " . showExpectation . showChar '\n'
|
||||
showError source error@Error{..}
|
||||
= withSGRCode [SetConsoleIntensity BoldIntensity] (showSourcePos Nothing errorPos) . showString ": " . withSGRCode [SetColor Foreground Vivid Red] (showString "error") . showString ": " . showExpectation error . showChar '\n'
|
||||
. showString context -- actualLines results include line endings, so no newline here
|
||||
. showString (replicate (succ (Info.column errorPos + lineNumberDigits)) ' ') . withSGRCode [SetColor Foreground Vivid Green] (showChar '^') . showChar '\n'
|
||||
. showString (prettyCallStack callStack) . showChar '\n'
|
||||
where showExpectation = case errorCause of
|
||||
UnexpectedEndOfInput [] -> showString "no rule to match at end of input nodes"
|
||||
UnexpectedEndOfInput symbols -> showString "expected " . showSymbols symbols . showString " at end of input nodes"
|
||||
UnexpectedSymbol symbols a -> showString "expected " . showSymbols symbols . showString ", but got " . shows a
|
||||
ParseError symbols -> showString "expected " . showSymbols symbols . showString ", but got parse error"
|
||||
context = maybe "\n" (toS . Source.sourceText . sconcat) (nonEmpty [ Source.Source (toS (showLineNumber i)) <> Source.Source ": " <> l | (i, l) <- zip [1..] (Source.actualLines source), inRange (Info.line errorPos - 2, Info.line errorPos) i ])
|
||||
where context = maybe "\n" (toS . Source.sourceText . sconcat) (nonEmpty [ Source.Source (toS (showLineNumber i)) <> Source.Source ": " <> l | (i, l) <- zip [1..] (Source.actualLines source), inRange (Info.line errorPos - 2, Info.line errorPos) i ])
|
||||
showLineNumber n = let s = show n in replicate (lineNumberDigits - length s) ' ' <> s
|
||||
lineNumberDigits = succ (floor (logBase 10 (fromIntegral (Info.line errorPos) :: Double)))
|
||||
showSGRCode = showString . setSGRCode
|
||||
withSGRCode code s = showSGRCode code . s . showSGRCode []
|
||||
|
||||
showExpectation :: Show symbol => Error symbol -> ShowS
|
||||
showExpectation Error{..} = case errorCause of
|
||||
UnexpectedEndOfInput [] -> showString "no rule to match at end of input nodes"
|
||||
UnexpectedEndOfInput symbols -> showString "expected " . showSymbols symbols . showString " at end of input nodes"
|
||||
UnexpectedSymbol symbols a -> showString "expected " . showSymbols symbols . showString ", but got " . shows a
|
||||
ParseError symbols -> showString "expected " . showSymbols symbols . showString ", but got parse error"
|
||||
|
||||
showSymbols :: Show symbol => [symbol] -> ShowS
|
||||
showSymbols [] = showString "end of input nodes"
|
||||
showSymbols [symbol] = shows symbol
|
||||
@ -200,15 +203,15 @@ assign assignment source = fmap snd . assignAllFrom assignment . makeState sourc
|
||||
|
||||
assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => Assignment (Node grammar) a -> AssignmentState grammar -> Result grammar (AssignmentState grammar, a)
|
||||
assignAllFrom assignment state = case runAssignment assignment state of
|
||||
Result es (Just (state, a)) -> case stateNodes (dropAnonymous state) of
|
||||
[] -> Result [] (Just (state, a))
|
||||
Rose (Just s :. _) _ :_ -> Result (if null es then [ Error (statePos state) (UnexpectedSymbol [] s) ] else es) Nothing
|
||||
Rose (Nothing :. _) _ :_ -> Result (if null es then [ Error (statePos state) (ParseError []) ] else es) Nothing
|
||||
Result err (Just (state, a)) -> case stateNodes (dropAnonymous state) of
|
||||
[] -> Result Nothing (Just (state, a))
|
||||
Rose (Just s :. _) _ :_ -> Result (err <|> Just (Error (statePos state) (UnexpectedSymbol [] s))) Nothing
|
||||
Rose (Nothing :. _) _ :_ -> Result (err <|> Just (Error (statePos state) (ParseError []))) Nothing
|
||||
r -> r
|
||||
|
||||
-- | Run an assignment of nodes in a grammar onto terms in a syntax.
|
||||
runAssignment :: forall grammar a. (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => Assignment (Node grammar) a -> AssignmentState grammar -> Result grammar (AssignmentState grammar, a)
|
||||
runAssignment = iterFreer run . fmap (\ a state -> Result [] (Just (state, a)))
|
||||
runAssignment = iterFreer run . fmap (\ a state -> pure (state, a))
|
||||
where run :: AssignmentF (Node grammar) x -> (x -> AssignmentState grammar -> Result grammar (AssignmentState grammar, a)) -> AssignmentState grammar -> Result grammar (AssignmentState grammar, a)
|
||||
run assignment yield initialState = case (assignment, stateNodes) of
|
||||
(Location, Rose (_ :. location) _ : _) -> yield location state
|
||||
@ -216,18 +219,16 @@ runAssignment = iterFreer run . fmap (\ a state -> Result [] (Just (state, a)))
|
||||
(Source, Rose (_ :. range :. _) _ : _) -> yield (Source.sourceText (Source.slice (offsetRange range (negate stateOffset)) stateSource)) (advanceState state)
|
||||
(Children childAssignment, Rose _ children : _) -> case assignAllFrom childAssignment state { stateNodes = children } of
|
||||
Result _ (Just (state', a)) -> yield a (advanceState state' { stateNodes = stateNodes })
|
||||
Result es Nothing -> Result es Nothing
|
||||
Result err Nothing -> Result err Nothing
|
||||
(Choose choices, Rose (Just symbol :. _) _ : _) | Just a <- IntMap.lookup (fromEnum symbol) choices -> yield a state
|
||||
-- Nullability: some rules, e.g. 'pure a' and 'many a', should match at the end of input. Either side of an alternation may be nullable, ergo Alt can match at the end of input.
|
||||
(Alt a b, _) -> yield a state <|> yield b state
|
||||
(Throw e, _) -> Result [ e ] Nothing
|
||||
(Throw e, _) -> Result (Just e) Nothing
|
||||
(Catch during handler, _) -> case yield during state of
|
||||
Result _ (Just (state', a)) -> Result [] (Just (state', a))
|
||||
Result (e:_) Nothing -> yield (handler e) state
|
||||
Result [] Nothing -> Result [] Nothing
|
||||
(_, []) -> Result [ Error statePos (UnexpectedEndOfInput expectedSymbols) ] Nothing
|
||||
(_, Rose (Just symbol :. _ :. nodeSpan :. Nil) _:_) -> Result [ Error (Info.spanStart nodeSpan) (UnexpectedSymbol expectedSymbols symbol) ] Nothing
|
||||
(_, Rose (Nothing :. _ :. nodeSpan :. Nil) _ : _) -> Result [ Error (Info.spanStart nodeSpan) (ParseError expectedSymbols) ] Nothing
|
||||
Result _ (Just (state', a)) -> Result Nothing (Just (state', a))
|
||||
Result err Nothing -> maybe (Result Nothing Nothing) (flip yield state . handler) err
|
||||
(_, []) -> Result (Just (Error statePos (UnexpectedEndOfInput expectedSymbols))) Nothing
|
||||
(_, Rose (symbol :. _ :. nodeSpan :. Nil) _:_) -> Result (Just (maybe (Error (Info.spanStart nodeSpan) (ParseError expectedSymbols)) (Error (Info.spanStart nodeSpan) . UnexpectedSymbol expectedSymbols) symbol)) Nothing
|
||||
where state@AssignmentState{..} = case assignment of
|
||||
Choose choices | all ((== Regular) . symbolType) (choiceSymbols choices) -> dropAnonymous initialState
|
||||
_ -> initialState
|
||||
@ -305,13 +306,13 @@ instance Show1 ErrorCause where
|
||||
ParseError expected -> showsUnaryWith (liftShowsPrec sp sl) "ParseError" d expected
|
||||
|
||||
instance Applicative (Result symbol) where
|
||||
pure = Result [] . Just
|
||||
Result e1 f <*> Result e2 a = Result (e1 <> e2) (f <*> a)
|
||||
pure = Result Nothing . Just
|
||||
Result e1 f <*> Result e2 a = Result (e1 <|> e2) (f <*> a)
|
||||
|
||||
instance Alternative (Result symbol) where
|
||||
empty = Result [] Nothing
|
||||
empty = Result Nothing Nothing
|
||||
Result e (Just a) <|> _ = Result e (Just a)
|
||||
Result e1 Nothing <|> Result e2 b = Result (e1 <> e2) b
|
||||
Result e1 Nothing <|> Result e2 b = Result (e1 <|> e2) b
|
||||
|
||||
instance MonadError (Error symbol) (Assignment (Node symbol)) where
|
||||
throwError :: HasCallStack => Error symbol -> Assignment (Node symbol) a
|
||||
|
@ -55,8 +55,16 @@ instance Eq1 Data.Syntax.Declaration.Constructor where liftEq = genericLiftEq
|
||||
instance Show1 Data.Syntax.Declaration.Constructor where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
|
||||
-- | Comprehension (e.g. ((a for b in c) in Python)
|
||||
data Comprehension a = Comprehension { comprehensionMap :: !a, comprehensionBindings :: ![a], comprehensionContext :: !a }
|
||||
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
|
||||
|
||||
instance Eq1 Comprehension where liftEq = genericLiftEq
|
||||
instance Show1 Comprehension where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
|
||||
-- | Import declarations.
|
||||
data Import a = Import { importContent :: ByteString }
|
||||
data Import a = Import { importContent :: ![a] }
|
||||
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
|
||||
|
||||
instance Eq1 Import where liftEq = genericLiftEq
|
||||
|
@ -8,21 +8,34 @@ import GHC.Generics
|
||||
import Prologue
|
||||
|
||||
-- | Typical prefix function application, like `f(x)` in many languages, or `f x` in Haskell.
|
||||
data Call a = Call { callFunction :: a, callParams :: [a] }
|
||||
data Call a = Call { callFunction :: !a, callParams :: ![a] }
|
||||
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
|
||||
|
||||
instance Eq1 Call where liftEq = genericLiftEq
|
||||
instance Show1 Call where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
|
||||
data Comparison a
|
||||
= LessThan !a !a
|
||||
| LessThanEqual !a !a
|
||||
| GreaterThan !a !a
|
||||
| GreaterThanEqual !a !a
|
||||
| Equal !a !a
|
||||
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
|
||||
|
||||
instance Eq1 Comparison where liftEq = genericLiftEq
|
||||
instance Show1 Comparison where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
|
||||
-- | Binary arithmetic operators.
|
||||
data Arithmetic a
|
||||
= Plus a a
|
||||
| Minus a a
|
||||
| Times a a
|
||||
| DividedBy a a
|
||||
| Modulo a a
|
||||
| Power a a
|
||||
| Negate a
|
||||
= Plus !a !a
|
||||
| Minus !a !a
|
||||
| Times !a !a
|
||||
| DividedBy !a !a
|
||||
| Modulo !a !a
|
||||
| Power !a !a
|
||||
| Negate !a
|
||||
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
|
||||
|
||||
instance Eq1 Arithmetic where liftEq = genericLiftEq
|
||||
@ -30,9 +43,9 @@ instance Show1 Arithmetic where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
-- | Boolean operators.
|
||||
data Boolean a
|
||||
= Or a a
|
||||
| And a a
|
||||
| Not a
|
||||
= Or !a !a
|
||||
| And !a !a
|
||||
| Not !a
|
||||
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
|
||||
|
||||
instance Eq1 Boolean where liftEq = genericLiftEq
|
||||
@ -40,13 +53,38 @@ instance Show1 Boolean where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
-- | Bitwise operators.
|
||||
data Bitwise a
|
||||
= BOr a a
|
||||
| BAnd a a
|
||||
| BXOr a a
|
||||
| LShift a a
|
||||
| RShift a a
|
||||
= BOr !a !a
|
||||
| BAnd !a !a
|
||||
| BXOr !a !a
|
||||
| LShift !a !a
|
||||
| RShift !a !a
|
||||
| Complement a
|
||||
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
|
||||
|
||||
instance Eq1 Bitwise where liftEq = genericLiftEq
|
||||
instance Show1 Bitwise where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
-- | Member Access (e.g. a.b)
|
||||
data MemberAccess a
|
||||
= MemberAccess !a !a
|
||||
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
|
||||
|
||||
instance Eq1 MemberAccess where liftEq = genericLiftEq
|
||||
instance Show1 MemberAccess where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
-- | Subscript (e.g a[1])
|
||||
data Subscript a
|
||||
= Subscript !a ![a]
|
||||
| Member !a !a
|
||||
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
|
||||
|
||||
instance Eq1 Subscript where liftEq = genericLiftEq
|
||||
instance Show1 Subscript where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
-- | ScopeResolution (e.g. import a.b in Python or a::b in C++)
|
||||
data ScopeResolution a
|
||||
= ScopeResolution ![a]
|
||||
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
|
||||
|
||||
instance Eq1 ScopeResolution where liftEq = genericLiftEq
|
||||
instance Show1 ScopeResolution where liftShowsPrec = genericLiftShowsPrec
|
||||
|
@ -4,10 +4,9 @@ module Data.Syntax.Literal where
|
||||
import Data.Align.Generic
|
||||
import Data.Functor.Classes.Eq.Generic
|
||||
import Data.Functor.Classes.Show.Generic
|
||||
import Data.Syntax.Comment
|
||||
import Data.Functor.Union
|
||||
import GHC.Generics
|
||||
import Prologue
|
||||
import Prologue hiding (Set)
|
||||
|
||||
-- Boolean
|
||||
|
||||
@ -45,8 +44,7 @@ instance Eq1 Data.Syntax.Literal.Float where liftEq = genericLiftEq
|
||||
instance Show1 Data.Syntax.Literal.Float where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
|
||||
|
||||
data Range a = Range { rangeStart :: a, rangeEnd :: a }
|
||||
data Range a = Range { rangeStart :: !a, rangeEnd :: !a }
|
||||
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
|
||||
|
||||
instance Eq1 Range where liftEq = genericLiftEq
|
||||
@ -97,14 +95,14 @@ instance Show1 Symbol where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
-- Collections
|
||||
|
||||
newtype Array a = Array { arrayElements :: [Union '[Identity, Comment] a] }
|
||||
newtype Array a = Array { arrayElements :: [a] }
|
||||
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
|
||||
|
||||
instance Eq1 Array where liftEq = genericLiftEq
|
||||
instance Show1 Array where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
|
||||
newtype Hash a = Hash { hashElements :: [Union '[KeyValue, Comment] a] }
|
||||
newtype Hash a = Hash { hashElements :: [a] }
|
||||
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
|
||||
|
||||
instance Eq1 Hash where liftEq = genericLiftEq
|
||||
@ -117,12 +115,21 @@ data KeyValue a = KeyValue { key :: !a, value :: !a }
|
||||
instance Eq1 KeyValue where liftEq = genericLiftEq
|
||||
instance Show1 KeyValue where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
data Tuple a = Tuple { tupleContents :: ![a]}
|
||||
|
||||
newtype Tuple a = Tuple { tupleContents :: [a]}
|
||||
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
|
||||
|
||||
instance Eq1 Tuple where liftEq = genericLiftEq
|
||||
instance Show1 Tuple where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
|
||||
newtype Set a = Set { setElements :: [a] }
|
||||
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
|
||||
|
||||
instance Eq1 Set where liftEq = genericLiftEq
|
||||
instance Show1 Set where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
-- TODO: Object literals as distinct from hash literals? Or coalesce object/hash literals into “key-value literals”?
|
||||
-- TODO: Function literals (lambdas, procs, anonymous functions, what have you).
|
||||
-- TODO: Regexp literals.
|
||||
|
||||
|
@ -4,6 +4,7 @@ module Language.Python.Syntax
|
||||
, Syntax
|
||||
, Syntax'
|
||||
, Grammar
|
||||
, Error
|
||||
) where
|
||||
|
||||
import Data.Align.Generic
|
||||
@ -11,7 +12,8 @@ import Data.Functor.Classes.Eq.Generic
|
||||
import Data.Functor.Classes.Show.Generic
|
||||
import Data.Functor.Union
|
||||
import qualified Data.Syntax as Syntax
|
||||
import Data.Syntax.Assignment
|
||||
import Data.Syntax.Assignment hiding (Error)
|
||||
import qualified Data.Syntax.Assignment as Assignment
|
||||
import qualified Data.Syntax.Comment as Comment
|
||||
import qualified Data.Syntax.Declaration as Declaration
|
||||
import qualified Data.Syntax.Expression as Expression
|
||||
@ -26,16 +28,26 @@ import Term
|
||||
type Syntax = Union Syntax'
|
||||
type Syntax' =
|
||||
'[ Comment.Comment
|
||||
, Declaration.Comprehension
|
||||
, Declaration.Function
|
||||
, Declaration.Import
|
||||
, Declaration.Variable
|
||||
, Expression.Arithmetic
|
||||
, Expression.Boolean
|
||||
, Expression.Bitwise
|
||||
, Expression.Call
|
||||
, Expression.Comparison
|
||||
, Expression.ScopeResolution
|
||||
, Expression.MemberAccess
|
||||
, Expression.Subscript
|
||||
, Literal.Array
|
||||
, Literal.Boolean
|
||||
, Literal.Float
|
||||
, Literal.Hash
|
||||
, Literal.Integer
|
||||
, Literal.KeyValue
|
||||
, Literal.Null
|
||||
, Literal.Set
|
||||
, Literal.String
|
||||
, Literal.TextElement
|
||||
, Literal.Tuple
|
||||
@ -44,12 +56,23 @@ type Syntax' =
|
||||
, Statement.If
|
||||
, Statement.Return
|
||||
, Statement.Yield
|
||||
, Language.Python.Syntax.Ellipsis
|
||||
, Syntax.Empty
|
||||
, Syntax.Error [Error Grammar]
|
||||
, Syntax.Error Error
|
||||
, Syntax.Identifier
|
||||
, []
|
||||
]
|
||||
|
||||
type Error = Assignment.Error Grammar
|
||||
|
||||
-- | Ellipsis (used in splice expressions and alternatively can be used as a fill in expression, like `undefined` in Haskell)
|
||||
data Ellipsis a = Ellipsis
|
||||
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
|
||||
|
||||
instance Eq1 Ellipsis where liftEq = genericLiftEq
|
||||
instance Show1 Ellipsis where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
|
||||
data Redirect a = Redirect !a !a
|
||||
deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
|
||||
|
||||
@ -60,28 +83,75 @@ instance Show1 Redirect where liftShowsPrec = genericLiftShowsPrec
|
||||
assignment :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
assignment = makeTerm <$> symbol Module <*> children (many declaration)
|
||||
|
||||
|
||||
declaration :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
declaration = comment <|> literal <|> statement <|> import' <|> importFrom
|
||||
|
||||
declaration = handleError $ comment <|> statement <|> expression
|
||||
|
||||
statement :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
statement = expressionStatement
|
||||
<|> ifStatement
|
||||
<|> returnStatement
|
||||
<|> identifier
|
||||
statement = assertStatement
|
||||
<|> assignment'
|
||||
<|> augmentedAssignment
|
||||
<|> printStatement
|
||||
<|> assertStatement
|
||||
<|> expressionStatement
|
||||
<|> globalStatement
|
||||
<|> ifStatement
|
||||
<|> identifier
|
||||
<|> import'
|
||||
<|> importFrom
|
||||
<|> printStatement
|
||||
<|> returnStatement
|
||||
|
||||
expressionStatement :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
expressionStatement = symbol ExpressionStatement *> children expression
|
||||
|
||||
expression :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
expression = await
|
||||
<|> binaryOperator
|
||||
<|> booleanOperator
|
||||
<|> call
|
||||
<|> comparisonOperator
|
||||
<|> comprehension
|
||||
<|> conditionalExpression
|
||||
<|> dottedName
|
||||
<|> ellipsis
|
||||
<|> lambda
|
||||
<|> keywordIdentifier
|
||||
<|> literal
|
||||
<|> memberAccess
|
||||
<|> notOperator
|
||||
<|> subscript
|
||||
<|> statement
|
||||
<|> tuple
|
||||
<|> unaryOperator
|
||||
|
||||
dottedName :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
dottedName = makeTerm <$> symbol DottedName <*> children (Expression.ScopeResolution <$> many expression)
|
||||
|
||||
ellipsis :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
ellipsis = makeTerm <$> symbol Grammar.Ellipsis <*> (Language.Python.Syntax.Ellipsis <$ source)
|
||||
|
||||
comparisonOperator :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
comparisonOperator = symbol ComparisonOperator >>= \ loc -> children (expression >>= \ lexpression -> makeComparison loc lexpression)
|
||||
where
|
||||
makeComparison loc lexpression = makeTerm loc <$ symbol AnonLAngle <*> (Expression.LessThan lexpression <$> expression)
|
||||
<|> makeTerm loc <$ symbol AnonLAngleEqual <*> (Expression.LessThanEqual lexpression <$> expression)
|
||||
<|> makeTerm loc <$ symbol AnonRAngle <*> (Expression.GreaterThan lexpression <$> expression)
|
||||
<|> makeTerm loc <$ symbol AnonRAngleEqual <*> (Expression.GreaterThanEqual lexpression <$> expression)
|
||||
<|> makeTerm loc <$ symbol AnonEqualEqual <*> (Expression.Equal lexpression <$> expression)
|
||||
<|> makeTerm loc <$ symbol AnonBangEqual <*> (Expression.Not <$> (makeTerm <$> location <*> (Expression.Equal lexpression <$> expression)))
|
||||
<|> makeTerm loc <$ symbol AnonNot <*> (Expression.Not <$> (makeTerm <$> location <*> (Expression.Member lexpression <$> expression)))
|
||||
<|> makeTerm loc <$ symbol AnonIn <*> (Expression.Member lexpression <$> expression)
|
||||
-- source is used here to push the cursor to the next node to enable matching against `AnonNot`
|
||||
<|> symbol AnonIs *> source *> (symbol AnonNot *> (makeTerm loc <$> Expression.Not <$> (makeTerm <$> location <*> (Expression.Equal lexpression <$> expression)))
|
||||
<|> (makeTerm loc <$> Expression.Equal lexpression <$> expression))
|
||||
|
||||
notOperator :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
notOperator = makeTerm <$> symbol NotOperator <*> children (Expression.Not <$> expression)
|
||||
|
||||
keywordIdentifier :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
keywordIdentifier = makeTerm <$> symbol KeywordIdentifier <*> children (Syntax.Identifier <$> source)
|
||||
|
||||
tuple :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
tuple = makeTerm <$> symbol Tuple <*> children (Literal.Tuple <$> (many expression))
|
||||
|
||||
expression :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
expression = identifier <|> statement <|> unaryOperator <|> binaryOperator <|> booleanOperator <|> tuple <|> literal
|
||||
|
||||
-- TODO: Consider flattening single element lists
|
||||
expressionList :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
expressionList = makeTerm <$> symbol ExpressionList <*> children (many expression)
|
||||
@ -145,7 +215,17 @@ identifier :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
identifier = makeTerm <$> symbol Identifier <*> (Syntax.Identifier <$> source)
|
||||
|
||||
literal :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
literal = string <|> integer <|> float <|> boolean <|> none <|> concatenatedString
|
||||
literal = string <|> integer <|> float <|> boolean <|> none <|> concatenatedString <|> list' <|> dictionary <|> set
|
||||
|
||||
set :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
set = makeTerm <$> symbol Set <*> children (Literal.Set <$> many expression)
|
||||
|
||||
dictionary :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
dictionary = makeTerm <$> symbol Dictionary <*> children (Literal.Hash <$> many pairs)
|
||||
where pairs = makeTerm <$> symbol Pair <*> children (Literal.KeyValue <$> expression <*> expression)
|
||||
|
||||
list' :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
list' = makeTerm <$> symbol List <*> children (Literal.Array <$> many expression)
|
||||
|
||||
-- TODO: Wrap `Literal.TextElement` with a `Literal.String`
|
||||
string :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
@ -163,17 +243,13 @@ integer = makeTerm <$> symbol Integer <*> (Literal.Integer <$> source)
|
||||
comment :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
|
||||
|
||||
expressionStatement :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
expressionStatement = symbol ExpressionStatement *> children (statement <|> literal <|> expression)
|
||||
|
||||
|
||||
-- TODO Possibly match against children for dotted name and identifiers
|
||||
import' :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
import' = makeTerm <$> symbol ImportStatement <*> (Declaration.Import <$> source)
|
||||
import' = makeTerm <$> symbol ImportStatement <*> children (Declaration.Import <$> many expression)
|
||||
|
||||
-- TODO Possibly match against children nodes
|
||||
importFrom :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
importFrom = makeTerm <$> symbol ImportFromStatement <*> (Declaration.Import <$> source)
|
||||
importFrom = makeTerm <$> symbol ImportFromStatement <*> children (Declaration.Import <$> many expression)
|
||||
|
||||
assertStatement :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
assertStatement = makeTerm <$ symbol AssertStatement <*> location <*> children (Expression.Call <$> (makeTerm <$> symbol AnonAssert <*> (Syntax.Identifier <$> source)) <*> many expression)
|
||||
@ -192,18 +268,29 @@ printStatement = do
|
||||
globalStatement :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
globalStatement = makeTerm <$> symbol GlobalStatement <*> children (Expression.Call <$> (makeTerm <$> symbol AnonGlobal <*> (Syntax.Identifier <$> source)) <*> many identifier)
|
||||
|
||||
await :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
await = makeTerm <$> symbol Await <*> children (Expression.Call <$> (makeTerm <$> symbol AnonAwait <*> (Syntax.Identifier <$> source)) <*> many expression)
|
||||
|
||||
returnStatement :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
returnStatement = makeTerm <$> symbol ReturnStatement <*> (Statement.Return <$> children expressionList)
|
||||
|
||||
|
||||
ifStatement :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
ifStatement = makeTerm <$> symbol IfStatement <*> children (Statement.If <$> condition <*> statement <*> (flip (foldr makeElif) <$> many elifClause <*> optionalElse))
|
||||
ifStatement = makeTerm <$> symbol IfStatement <*> children (Statement.If <$> expression <*> statement <*> (flip (foldr makeElif) <$> many elifClause <*> optionalElse))
|
||||
where elseClause = symbol ElseClause *> children statement
|
||||
elifClause = (,) <$ symbol ElifClause <*> location <*> children (Statement.If <$> condition <*> statement)
|
||||
condition = boolean
|
||||
elifClause = (,) <$ symbol ElifClause <*> location <*> children (Statement.If <$> expression <*> statement)
|
||||
optionalElse = fromMaybe <$> emptyTerm <*> optional elseClause
|
||||
makeElif (loc, makeIf) rest = makeTerm loc (makeIf rest)
|
||||
|
||||
memberAccess :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
memberAccess = makeTerm <$> symbol Attribute <*> children (Expression.MemberAccess <$> expression <*> expression)
|
||||
|
||||
subscript :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
subscript = makeTerm <$> symbol Subscript <*> children (Expression.Subscript <$> expression <*> many expression)
|
||||
|
||||
call :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
call = makeTerm <$> symbol Call <*> children (Expression.Call <$> identifier <*> (symbol ArgumentList *> children (many expression)
|
||||
<|> some comprehension))
|
||||
|
||||
boolean :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
boolean = makeTerm <$> symbol Grammar.True <*> (Literal.true <$ source)
|
||||
@ -212,8 +299,33 @@ boolean = makeTerm <$> symbol Grammar.True <*> (Literal.true <$ source)
|
||||
none :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
none = makeTerm <$> symbol None <*> (Literal.Null <$ source)
|
||||
|
||||
lambda :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
lambda = makeTerm <$> symbol Lambda <*> children (Declaration.Function <$> lambdaIdentifier <*> lambdaParameters <*> lambdaBody)
|
||||
where lambdaIdentifier = makeTerm <$> symbol AnonLambda <*> (Syntax.Identifier <$> source)
|
||||
lambdaParameters = many identifier
|
||||
lambdaBody = expression
|
||||
|
||||
comprehension :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
comprehension = makeTerm <$> symbol GeneratorExpression <*> children (comprehensionDeclaration expression)
|
||||
<|> makeTerm <$> symbol ListComprehension <*> children (comprehensionDeclaration expression)
|
||||
<|> makeTerm <$> symbol SetComprehension <*> children (comprehensionDeclaration expression)
|
||||
<|> makeTerm <$> symbol DictionaryComprehension <*> children (comprehensionDeclaration keyValue)
|
||||
where
|
||||
keyValue = makeTerm <$> location <*> (Literal.KeyValue <$> expression <*> expression)
|
||||
comprehensionDeclaration preceeding = Declaration.Comprehension <$> preceeding <* symbol Variables <*> children (many expression) <*> (flip (foldr makeComprehension) <$> many nestedComprehension <*> expression)
|
||||
makeComprehension (loc, makeRest) rest = makeTerm loc (makeRest rest)
|
||||
nestedComprehension = (,) <$> location <*> (Declaration.Comprehension <$> expression <* symbol Variables <*> children (many expression))
|
||||
|
||||
conditionalExpression :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
conditionalExpression = makeTerm <$> symbol ConditionalExpression <*> children (expression >>= \ thenBranch -> expression >>= \ conditional -> Statement.If conditional thenBranch <$> (expression <|> emptyTerm))
|
||||
|
||||
makeTerm :: HasCallStack => InUnion Syntax' f => a -> f (Term Syntax a) -> Term Syntax a
|
||||
makeTerm a f = cofree (a :< inj f)
|
||||
|
||||
emptyTerm :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
emptyTerm = makeTerm <$> location <*> pure Syntax.Empty
|
||||
|
||||
handleError :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location) -> Assignment (Node Grammar) (Term Syntax Location)
|
||||
handleError = flip catchError $ \ error -> case errorCause error of
|
||||
UnexpectedEndOfInput _ -> throwError error
|
||||
_ -> makeTerm <$> location <*> (Syntax.Error error <$ source)
|
||||
|
@ -4,11 +4,13 @@ module Language.Ruby.Syntax
|
||||
, Syntax
|
||||
, Syntax'
|
||||
, Grammar
|
||||
, Error
|
||||
) where
|
||||
|
||||
import Data.Functor.Union
|
||||
import qualified Data.Syntax as Syntax
|
||||
import Data.Syntax.Assignment
|
||||
import Data.Syntax.Assignment hiding (Error)
|
||||
import qualified Data.Syntax.Assignment as Assignment
|
||||
import qualified Data.Syntax.Comment as Comment
|
||||
import qualified Data.Syntax.Declaration as Declaration
|
||||
import qualified Data.Syntax.Expression as Expression
|
||||
@ -46,11 +48,13 @@ type Syntax' =
|
||||
, Statement.While
|
||||
, Statement.Yield
|
||||
, Syntax.Empty
|
||||
, Syntax.Error [Error Grammar]
|
||||
, Syntax.Error Error
|
||||
, Syntax.Identifier
|
||||
, []
|
||||
]
|
||||
|
||||
type Error = Assignment.Error Grammar
|
||||
|
||||
|
||||
-- | Assignment from AST in Ruby’s grammar onto a program in Ruby’s syntax.
|
||||
assignment :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
|
||||
@ -157,4 +161,4 @@ emptyTerm = makeTerm <$> location <*> pure Syntax.Empty
|
||||
handleError :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location) -> Assignment (Node Grammar) (Term Syntax Location)
|
||||
handleError = flip catchError $ \ error -> case errorCause error of
|
||||
UnexpectedEndOfInput _ -> throwError error
|
||||
_ -> makeTerm <$> location <*> (Syntax.Error [error] <$ source)
|
||||
_ -> makeTerm <$> location <*> (Syntax.Error error <$ source)
|
||||
|
@ -30,7 +30,7 @@ data Parser term where
|
||||
-- | A parser producing 'AST' using a 'TS.Language'.
|
||||
ASTParser :: (Bounded grammar, Enum grammar) => Ptr TS.Language -> Parser (AST grammar)
|
||||
-- | A parser producing an à la carte term given an 'AST'-producing parser and an 'Assignment' onto 'Term's in some syntax type. Assignment errors will result in a top-level 'Syntax.Error' node.
|
||||
AssignmentParser :: (Bounded grammar, Enum grammar, Eq grammar, Show grammar, Symbol grammar, InUnion fs (Syntax.Error [Error grammar]))
|
||||
AssignmentParser :: (Bounded grammar, Enum grammar, Eq grammar, Show grammar, Symbol grammar, InUnion fs (Syntax.Error (Error grammar)))
|
||||
=> Parser (AST grammar) -- ^ A parser producing 'AST'.
|
||||
-> Assignment (Node grammar) (Term (Union fs) Location) -- ^ An assignment from 'AST' onto 'Term's.
|
||||
-> Parser (Term (Union fs) Location) -- ^ A parser of 'Term's.
|
||||
@ -63,9 +63,9 @@ runParser parser = case parser of
|
||||
ASTParser language -> parseToAST language
|
||||
AssignmentParser parser assignment -> \ source -> do
|
||||
ast <- runParser parser source
|
||||
let Result errors term = assign assignment source ast
|
||||
traverse_ (putStr . ($ "") . showError source) errors
|
||||
pure (fromMaybe (cofree ((totalRange source :. totalSpan source :. Nil) :< inj (Syntax.Error errors))) term)
|
||||
let Result err term = assign assignment source ast
|
||||
traverse_ (putStr . ($ "") . showError source) err
|
||||
pure (fromMaybe (cofree ((totalRange source :. totalSpan source :. Nil) :< inj (Syntax.Error (fromMaybe (Error (SourcePos 0 0) (UnexpectedEndOfInput [])) err)))) term)
|
||||
TreeSitterParser language tslanguage -> treeSitterParser language tslanguage
|
||||
MarkdownParser -> cmarkParser
|
||||
LineByLineParser -> lineByLineParser
|
||||
|
@ -9,6 +9,7 @@ module Renderer
|
||||
, renderJSONTerm
|
||||
, renderToC
|
||||
, declarationAlgebra
|
||||
, syntaxDeclarationAlgebra
|
||||
, identifierAlgebra
|
||||
, Summaries(..)
|
||||
, File(..)
|
||||
|
@ -4,23 +4,24 @@ module Renderer.TOC
|
||||
, diffTOC
|
||||
, Summaries(..)
|
||||
, JSONSummary(..)
|
||||
, Summarizable(..)
|
||||
, isValidSummary
|
||||
, Declaration(..)
|
||||
, declaration
|
||||
, declarationAlgebra
|
||||
, syntaxDeclarationAlgebra
|
||||
, Entry(..)
|
||||
, tableOfContentsBy
|
||||
, dedupe
|
||||
, entrySummary
|
||||
) where
|
||||
|
||||
import Category as C
|
||||
import Data.Aeson
|
||||
import Data.Align (crosswalk)
|
||||
import Data.Functor.Both hiding (fst, snd)
|
||||
import qualified Data.Functor.Both as Both
|
||||
import Data.Functor.Listable
|
||||
import Data.Functor.Union
|
||||
import Data.Proxy
|
||||
import Data.Text (toLower)
|
||||
import Data.Text.Listable
|
||||
import Data.These
|
||||
@ -33,6 +34,9 @@ import qualified Data.List as List
|
||||
import qualified Data.Map as Map hiding (null)
|
||||
import Source hiding (null)
|
||||
import Syntax as S
|
||||
import Data.Syntax.Algebra (RAlgebra)
|
||||
import qualified Data.Syntax as Syntax
|
||||
import qualified Data.Syntax.Declaration as Declaration
|
||||
import Term
|
||||
|
||||
data Summaries = Summaries { changes, errors :: !(Map Text [Value]) }
|
||||
@ -48,27 +52,24 @@ instance StringConv Summaries ByteString where
|
||||
instance ToJSON Summaries where
|
||||
toJSON Summaries{..} = object [ "changes" .= changes, "errors" .= errors ]
|
||||
|
||||
data JSONSummary = JSONSummary { info :: Summarizable }
|
||||
data JSONSummary
|
||||
= JSONSummary
|
||||
{ summaryCategoryName :: Text
|
||||
, summaryTermName :: Text
|
||||
, summarySourceSpan :: SourceSpan
|
||||
, summaryChangeType :: Text
|
||||
}
|
||||
| ErrorSummary { error :: Text, errorSpan :: SourceSpan }
|
||||
deriving (Generic, Eq, Show)
|
||||
|
||||
instance ToJSON JSONSummary where
|
||||
toJSON (JSONSummary Summarizable{..}) = object [ "changeType" .= summarizableChangeType, "category" .= toCategoryName summarizableCategory, "term" .= summarizableTermName, "span" .= summarizableSourceSpan ]
|
||||
toJSON JSONSummary{..} = object [ "changeType" .= summaryChangeType, "category" .= summaryCategoryName, "term" .= summaryTermName, "span" .= summarySourceSpan ]
|
||||
toJSON ErrorSummary{..} = object [ "error" .= error, "span" .= errorSpan ]
|
||||
|
||||
isValidSummary :: JSONSummary -> Bool
|
||||
isValidSummary ErrorSummary{} = False
|
||||
isValidSummary _ = True
|
||||
|
||||
data Summarizable
|
||||
= Summarizable
|
||||
{ summarizableCategory :: Category
|
||||
, summarizableTermName :: Text
|
||||
, summarizableSourceSpan :: SourceSpan
|
||||
, summarizableChangeType :: Text
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | A declaration’s identifier and type.
|
||||
data Declaration
|
||||
= MethodDeclaration { declarationIdentifier :: Text }
|
||||
@ -76,16 +77,17 @@ data Declaration
|
||||
| ErrorDeclaration { declarationIdentifier :: Text }
|
||||
deriving (Eq, Generic, NFData, Show)
|
||||
|
||||
getDeclaration :: HasField fields (Maybe Declaration) => Record fields -> Maybe Declaration
|
||||
getDeclaration = getField
|
||||
|
||||
-- | Produce the annotations of nodes representing declarations.
|
||||
declaration :: (HasField fields (Maybe Declaration), HasField fields Category) => TermF (Syntax Text) (Record fields) a -> Maybe (Record fields)
|
||||
declaration (annotation :< syntax)
|
||||
| S.ParseError{} <- syntax = Just (setCategory annotation C.ParseError)
|
||||
| otherwise = annotation <$ (getField annotation :: Maybe Declaration)
|
||||
declaration :: HasField fields (Maybe Declaration) => TermF f (Record fields) a -> Maybe (Record fields)
|
||||
declaration (annotation :< _) = annotation <$ (getField annotation :: Maybe Declaration)
|
||||
|
||||
|
||||
-- | Compute 'Declaration's for methods and functions.
|
||||
declarationAlgebra :: HasField fields Range => Source -> TermF (Syntax Text) (Record fields) (Term (Syntax Text) (Record fields), Maybe Declaration) -> Maybe Declaration
|
||||
declarationAlgebra source r = case tailF r of
|
||||
-- | Compute 'Declaration's for methods and functions in 'Syntax'.
|
||||
syntaxDeclarationAlgebra :: HasField fields Range => Source -> RAlgebra (SyntaxTermF Text fields) (SyntaxTerm Text fields) (Maybe Declaration)
|
||||
syntaxDeclarationAlgebra source r = case tailF r of
|
||||
S.Function (identifier, _) _ _ -> Just $ FunctionDeclaration (getSource identifier)
|
||||
S.Method _ (identifier, _) Nothing _ _ -> Just $ MethodDeclaration (getSource identifier)
|
||||
S.Method _ (identifier, _) (Just (receiver, _)) _ _
|
||||
@ -96,6 +98,18 @@ declarationAlgebra source r = case tailF r of
|
||||
_ -> Nothing
|
||||
where getSource = toText . flip Source.slice source . byteRange . extract
|
||||
|
||||
-- | Compute 'Declaration's for methods and functions.
|
||||
declarationAlgebra :: (InUnion fs Declaration.Function, InUnion fs Declaration.Method, InUnion fs (Syntax.Error error), Show error, Functor (Union fs), HasField fields Range)
|
||||
=> Proxy error
|
||||
-> Source
|
||||
-> RAlgebra (TermF (Union fs) (Record fields)) (Term (Union fs) (Record fields)) (Maybe Declaration)
|
||||
declarationAlgebra proxy source r
|
||||
| Just (Declaration.Function (identifier, _) _ _) <- prj (tailF r) = Just $ FunctionDeclaration (getSource identifier)
|
||||
| Just (Declaration.Method (identifier, _) _ _) <- prj (tailF r) = Just $ MethodDeclaration (getSource identifier)
|
||||
| Just (Syntax.Error err) <- prj (tailF r) = Just $ ErrorDeclaration (show (err `asProxyTypeOf` proxy))
|
||||
| otherwise = Nothing
|
||||
where getSource = toText . flip Source.slice source . byteRange . extract
|
||||
|
||||
|
||||
-- | An entry in a table of contents.
|
||||
data Entry a
|
||||
@ -121,7 +135,7 @@ tableOfContentsBy selector = fromMaybe [] . iter diffAlgebra . fmap (Just . fmap
|
||||
| otherwise = fold r
|
||||
patchEntry = these Deleted Inserted (const Replaced) . unPatch
|
||||
|
||||
dedupe :: (HasField fields Category, HasField fields (Maybe Declaration)) => [Entry (Record fields)] -> [Entry (Record fields)]
|
||||
dedupe :: HasField fields (Maybe Declaration) => [Entry (Record fields)] -> [Entry (Record fields)]
|
||||
dedupe = foldl' go []
|
||||
where go xs x | (_, _:_) <- find (exactMatch `on` entryPayload) x xs = xs
|
||||
| (front, similar : back) <- find (similarMatch `on` entryPayload) x xs =
|
||||
@ -131,24 +145,23 @@ dedupe = foldl' go []
|
||||
find p x = List.break (p x)
|
||||
exactMatch = (==) `on` getDeclaration
|
||||
similarMatch a b = sameCategory a b && similarDeclaration a b
|
||||
sameCategory = (==) `on` category
|
||||
sameCategory = (==) `on` fmap toCategoryName . getDeclaration
|
||||
similarDeclaration = (==) `on` fmap (toLower . declarationIdentifier) . getDeclaration
|
||||
getDeclaration :: HasField fields (Maybe Declaration) => Record fields -> Maybe Declaration
|
||||
getDeclaration = getField
|
||||
|
||||
-- | Construct a 'JSONSummary' from an 'Entry'. Returns 'Nothing' for 'Unchanged' patches.
|
||||
entrySummary :: (HasField fields Category, HasField fields (Maybe Declaration), HasField fields SourceSpan) => Entry (Record fields) -> Maybe JSONSummary
|
||||
entrySummary :: (HasField fields (Maybe Declaration), HasField fields SourceSpan) => Entry (Record fields) -> Maybe JSONSummary
|
||||
entrySummary entry = case entry of
|
||||
Unchanged _ -> Nothing
|
||||
Changed a -> Just (recordSummary a "modified")
|
||||
Deleted a -> Just (recordSummary a "removed")
|
||||
Inserted a -> Just (recordSummary a "added")
|
||||
Replaced a -> Just (recordSummary a "modified")
|
||||
where recordSummary record
|
||||
| C.ParseError <- category record = const (ErrorSummary (maybe "" declarationIdentifier (getField record :: Maybe Declaration)) (sourceSpan record))
|
||||
| otherwise = JSONSummary . Summarizable (category record) (maybe "" declarationIdentifier (getField record :: Maybe Declaration)) (sourceSpan record)
|
||||
Changed a -> recordSummary a "modified"
|
||||
Deleted a -> recordSummary a "removed"
|
||||
Inserted a -> recordSummary a "added"
|
||||
Replaced a -> recordSummary a "modified"
|
||||
where recordSummary record = case getDeclaration record of
|
||||
Just (ErrorDeclaration text) -> Just . const (ErrorSummary text (sourceSpan record))
|
||||
Just declaration -> Just . JSONSummary (toCategoryName declaration) (declarationIdentifier declaration) (sourceSpan record)
|
||||
Nothing -> const Nothing
|
||||
|
||||
renderToC :: (HasField fields Category, HasField fields (Maybe Declaration), HasField fields SourceSpan) => Both SourceBlob -> Diff (Syntax Text) (Record fields) -> Summaries
|
||||
renderToC :: (HasField fields (Maybe Declaration), HasField fields SourceSpan, Traversable f) => Both SourceBlob -> Diff f (Record fields) -> Summaries
|
||||
renderToC blobs = uncurry Summaries . bimap toMap toMap . List.partition isValidSummary . diffTOC
|
||||
where toMap [] = mempty
|
||||
toMap as = Map.singleton summaryKey (toJSON <$> as)
|
||||
@ -158,14 +171,15 @@ renderToC blobs = uncurry Summaries . bimap toMap toMap . List.partition isValid
|
||||
| before == after -> after
|
||||
| otherwise -> before <> " -> " <> after
|
||||
|
||||
diffTOC :: (HasField fields Category, HasField fields (Maybe Declaration), HasField fields SourceSpan) => Diff (Syntax Text) (Record fields) -> [JSONSummary]
|
||||
diffTOC :: (HasField fields (Maybe Declaration), HasField fields SourceSpan, Traversable f) => Diff f (Record fields) -> [JSONSummary]
|
||||
diffTOC = mapMaybe entrySummary . dedupe . tableOfContentsBy declaration
|
||||
|
||||
-- The user-facing category name
|
||||
toCategoryName :: Category -> Text
|
||||
toCategoryName category = case category of
|
||||
C.SingletonMethod -> "Method"
|
||||
c -> show c
|
||||
toCategoryName :: Declaration -> Text
|
||||
toCategoryName declaration = case declaration of
|
||||
FunctionDeclaration _ -> "Function"
|
||||
MethodDeclaration _ -> "Method"
|
||||
ErrorDeclaration _ -> "ParseError"
|
||||
|
||||
instance Listable Declaration where
|
||||
tiers
|
||||
|
@ -11,11 +11,15 @@ import Algorithm hiding (diff)
|
||||
import Data.Align.Generic (GAlign)
|
||||
import Data.Functor.Both as Both
|
||||
import Data.Functor.Classes (Eq1, Show1)
|
||||
import Data.Functor.Union
|
||||
import Data.Proxy
|
||||
import Data.Record
|
||||
import qualified Data.Syntax.Declaration as Declaration
|
||||
import Diff
|
||||
import Info
|
||||
import Interpreter
|
||||
import qualified Language
|
||||
import qualified Language.Python.Syntax as Python
|
||||
import Patch
|
||||
import Parser
|
||||
import Prologue
|
||||
@ -55,14 +59,15 @@ diffBlobPairs renderer = fmap toS . distributeFoldMap (diffBlobPair renderer) .
|
||||
-- | A task to parse a pair of 'SourceBlob's, diff them, and render the 'Diff'.
|
||||
diffBlobPair :: DiffRenderer output -> Both SourceBlob -> Task output
|
||||
diffBlobPair renderer blobs = case (renderer, effectiveLanguage) of
|
||||
(ToCDiffRenderer, _) -> run (\ source -> parse syntaxParser source >>= decorate (declarationAlgebra source)) diffTerms (renderToC blobs)
|
||||
(ToCDiffRenderer, Just Language.Python) -> run (\ source -> parse pythonParser source >>= decorate (declarationAlgebra (Proxy :: Proxy Python.Error) source) . hoistCofree (weaken :: Union fs a -> Union (Declaration.Method ': fs) a)) diffLinearly (renderToC blobs)
|
||||
(ToCDiffRenderer, _) -> run (\ source -> parse syntaxParser source >>= decorate (syntaxDeclarationAlgebra source)) diffTerms (renderToC blobs)
|
||||
(JSONDiffRenderer, Just Language.Python) -> run (parse pythonParser) diffLinearly (renderJSONDiff blobs)
|
||||
(JSONDiffRenderer, _) -> run (decorate identifierAlgebra <=< parse syntaxParser) diffTerms (renderJSONDiff blobs)
|
||||
(PatchDiffRenderer, Just Language.Python) -> run (parse pythonParser) diffLinearly (renderPatch blobs)
|
||||
(PatchDiffRenderer, _) -> run (parse syntaxParser) diffTerms (renderPatch blobs)
|
||||
(SExpressionDiffRenderer, Just Language.Python) -> run (decorate (ConstructorLabel . constructorLabel) <=< parse pythonParser) diffLinearly (renderSExpressionDiff . mapAnnotations keepConstructorLabel)
|
||||
(SExpressionDiffRenderer, _) -> run (parse syntaxParser) diffTerms (renderSExpressionDiff . mapAnnotations keepCategory)
|
||||
(IdentityDiffRenderer, _) -> run (\ source -> parse syntaxParser source >>= decorate (declarationAlgebra source)) diffTerms Just
|
||||
(IdentityDiffRenderer, _) -> run (\ source -> parse syntaxParser source >>= decorate (syntaxDeclarationAlgebra source)) diffTerms Just
|
||||
where effectiveLanguage = runBothWith (<|>) (blobLanguage <$> blobs)
|
||||
syntaxParser = parserForLanguage effectiveLanguage
|
||||
|
||||
|
@ -14,11 +14,11 @@ spec :: Spec
|
||||
spec = do
|
||||
describe "Applicative" $
|
||||
it "matches in sequence" $
|
||||
runAssignment ((,) <$> red <*> red) (makeState "helloworld" [Rose (rec Red 0 5) [], Rose (rec Red 5 10) []]) `shouldBe` Result [] (Just (AssignmentState 10 (Info.SourcePos 1 11) "" [], (Out "hello", Out "world")))
|
||||
runAssignment ((,) <$> red <*> red) (makeState "helloworld" [Rose (rec Red 0 5) [], Rose (rec Red 5 10) []]) `shouldBe` Result Nothing (Just (AssignmentState 10 (Info.SourcePos 1 11) "" [], (Out "hello", Out "world")))
|
||||
|
||||
describe "Alternative" $ do
|
||||
it "attempts multiple alternatives" $
|
||||
runAssignment (green <|> red) (makeState "hello" [Rose (rec Red 0 5) []]) `shouldBe` Result [] (Just (AssignmentState 5 (Info.SourcePos 1 6) "" [], Out "hello"))
|
||||
runAssignment (green <|> red) (makeState "hello" [Rose (rec Red 0 5) []]) `shouldBe` Result Nothing (Just (AssignmentState 5 (Info.SourcePos 1 6) "" [], Out "hello"))
|
||||
|
||||
it "matches repetitions" $
|
||||
let s = "colourless green ideas sleep furiously"
|
||||
@ -31,35 +31,35 @@ spec = do
|
||||
|
||||
describe "symbol" $ do
|
||||
it "matches nodes with the same symbol" $
|
||||
snd <$> runAssignment red (makeState "hello" [Rose (rec Red 0 5) []]) `shouldBe` Result [] (Just (Out "hello"))
|
||||
snd <$> runAssignment red (makeState "hello" [Rose (rec Red 0 5) []]) `shouldBe` Result Nothing (Just (Out "hello"))
|
||||
|
||||
it "does not advance past the current node" $
|
||||
let initialState = makeState "hi" [ Rose (rec Red 0 2) [] ] in
|
||||
fst <$> runAssignment (symbol Red) initialState `shouldBe` Result [] (Just initialState)
|
||||
fst <$> runAssignment (symbol Red) initialState `shouldBe` Result Nothing (Just initialState)
|
||||
|
||||
describe "source" $ do
|
||||
it "produces the node’s source" $
|
||||
assign source "hi" (Rose (rec Red 0 2) []) `shouldBe` Result [] (Just "hi")
|
||||
assign source "hi" (Rose (rec Red 0 2) []) `shouldBe` Result Nothing (Just "hi")
|
||||
|
||||
it "advances past the current node" $
|
||||
fst <$> runAssignment source (makeState "hi" [ Rose (rec Red 0 2) [] ]) `shouldBe` Result [] (Just (AssignmentState 2 (Info.SourcePos 1 3) "" []))
|
||||
fst <$> runAssignment source (makeState "hi" [ Rose (rec Red 0 2) [] ]) `shouldBe` Result Nothing (Just (AssignmentState 2 (Info.SourcePos 1 3) "" []))
|
||||
|
||||
describe "children" $ do
|
||||
it "advances past the current node" $
|
||||
fst <$> runAssignment (children (pure (Out ""))) (makeState "a" [Rose (rec Red 0 1) []]) `shouldBe` Result [] (Just (AssignmentState 1 (Info.SourcePos 1 2) "" []))
|
||||
fst <$> runAssignment (children (pure (Out ""))) (makeState "a" [Rose (rec Red 0 1) []]) `shouldBe` Result Nothing (Just (AssignmentState 1 (Info.SourcePos 1 2) "" []))
|
||||
|
||||
it "matches if its subrule matches" $
|
||||
() <$ runAssignment (children red) (makeState "a" [Rose (rec Blue 0 1) [Rose (rec Red 0 1) []]]) `shouldBe` Result [] (Just ())
|
||||
() <$ runAssignment (children red) (makeState "a" [Rose (rec Blue 0 1) [Rose (rec Red 0 1) []]]) `shouldBe` Result Nothing (Just ())
|
||||
|
||||
it "does not match if its subrule does not match" $
|
||||
(runAssignment (children red) (makeState "a" [Rose (rec Blue 0 1) [Rose (rec Green 0 1) []]])) `shouldBe` Result [ Error (Info.SourcePos 1 1) (UnexpectedSymbol [Red] Green) ] Nothing
|
||||
(runAssignment (children red) (makeState "a" [Rose (rec Blue 0 1) [Rose (rec Green 0 1) []]])) `shouldBe` Result (Just (Error (Info.SourcePos 1 1) (UnexpectedSymbol [Red] Green))) Nothing
|
||||
|
||||
it "matches nested children" $
|
||||
runAssignment
|
||||
(symbol Red *> children (symbol Green *> children (symbol Blue *> source)))
|
||||
(makeState "1" [ Rose (rec Red 0 1) [ Rose (rec Green 0 1) [ Rose (rec Blue 0 1) [] ] ] ])
|
||||
`shouldBe`
|
||||
Result [] (Just (AssignmentState 1 (Info.SourcePos 1 2) "" [], "1"))
|
||||
Result Nothing (Just (AssignmentState 1 (Info.SourcePos 1 2) "" [], "1"))
|
||||
|
||||
it "continues after children" $
|
||||
resultValue (runAssignment
|
||||
@ -76,17 +76,17 @@ spec = do
|
||||
(makeState "12" [ Rose (rec Red 0 2) [ Rose (rec Green 0 1) [ Rose (rec Blue 0 1) [] ]
|
||||
, Rose (rec Green 1 2) [ Rose (rec Blue 1 2) [] ] ] ])
|
||||
`shouldBe`
|
||||
Result [] (Just (AssignmentState 2 (Info.SourcePos 1 3) "" [], ["1", "2"]))
|
||||
Result Nothing (Just (AssignmentState 2 (Info.SourcePos 1 3) "" [], ["1", "2"]))
|
||||
|
||||
describe "runAssignment" $ do
|
||||
it "drops anonymous nodes before matching symbols" $
|
||||
runAssignment red (makeState "magenta red" [Rose (rec Magenta 0 7) [], Rose (rec Red 8 11) []]) `shouldBe` Result [] (Just (AssignmentState 11 (Info.SourcePos 1 12) "" [], Out "red"))
|
||||
runAssignment red (makeState "magenta red" [Rose (rec Magenta 0 7) [], Rose (rec Red 8 11) []]) `shouldBe` Result Nothing (Just (AssignmentState 11 (Info.SourcePos 1 12) "" [], Out "red"))
|
||||
|
||||
it "does not drop anonymous nodes after matching" $
|
||||
runAssignment red (makeState "red magenta" [Rose (rec Red 0 3) [], Rose (rec Magenta 4 11) []]) `shouldBe` Result [] (Just (AssignmentState 3 (Info.SourcePos 1 4) " magenta" [Rose (rec Magenta 4 11) []], Out "red"))
|
||||
runAssignment red (makeState "red magenta" [Rose (rec Red 0 3) [], Rose (rec Magenta 4 11) []]) `shouldBe` Result Nothing (Just (AssignmentState 3 (Info.SourcePos 1 4) " magenta" [Rose (rec Magenta 4 11) []], Out "red"))
|
||||
|
||||
it "does not drop anonymous nodes when requested" $
|
||||
runAssignment ((,) <$> magenta <*> red) (makeState "magenta red" [Rose (rec Magenta 0 7) [], Rose (rec Red 8 11) []]) `shouldBe` Result [] (Just (AssignmentState 11 (Info.SourcePos 1 12) "" [], (Out "magenta", Out "red")))
|
||||
runAssignment ((,) <$> magenta <*> red) (makeState "magenta red" [Rose (rec Magenta 0 7) [], Rose (rec Red 8 11) []]) `shouldBe` Result Nothing (Just (AssignmentState 11 (Info.SourcePos 1 12) "" [], (Out "magenta", Out "red")))
|
||||
|
||||
rec :: symbol -> Int -> Int -> Record '[Maybe symbol, Range, SourceSpan]
|
||||
rec symbol start end = Just symbol :. Range start end :. Info.SourceSpan (Info.SourcePos 1 (succ start)) (Info.SourcePos 1 (succ end)) :. Nil
|
||||
|
@ -60,39 +60,39 @@ spec = parallel $ do
|
||||
sourceBlobs <- blobsForPaths (both "ruby/methods.A.rb" "ruby/methods.B.rb")
|
||||
Just diff <- runTask (diffBlobPair IdentityDiffRenderer sourceBlobs)
|
||||
diffTOC diff `shouldBe`
|
||||
[ JSONSummary $ Summarizable C.SingletonMethod "self.foo" (sourceSpanBetween (1, 1) (2, 4)) "added"
|
||||
, JSONSummary $ Summarizable C.Method "bar" (sourceSpanBetween (4, 1) (6, 4)) "modified"
|
||||
, JSONSummary $ Summarizable C.Method "baz" (sourceSpanBetween (4, 1) (5, 4)) "removed" ]
|
||||
[ JSONSummary "Method" "self.foo" (sourceSpanBetween (1, 1) (2, 4)) "added"
|
||||
, JSONSummary "Method" "bar" (sourceSpanBetween (4, 1) (6, 4)) "modified"
|
||||
, JSONSummary "Method" "baz" (sourceSpanBetween (4, 1) (5, 4)) "removed" ]
|
||||
|
||||
it "dedupes changes in same parent method" $ do
|
||||
sourceBlobs <- blobsForPaths (both "javascript/duplicate-parent.A.js" "javascript/duplicate-parent.B.js")
|
||||
Just diff <- runTask (diffBlobPair IdentityDiffRenderer sourceBlobs)
|
||||
diffTOC diff `shouldBe`
|
||||
[ JSONSummary $ Summarizable C.Function "myFunction" (sourceSpanBetween (1, 1) (6, 2)) "modified" ]
|
||||
[ JSONSummary "Function" "myFunction" (sourceSpanBetween (1, 1) (6, 2)) "modified" ]
|
||||
|
||||
it "dedupes similar methods" $ do
|
||||
sourceBlobs <- blobsForPaths (both "javascript/erroneous-duplicate-method.A.js" "javascript/erroneous-duplicate-method.B.js")
|
||||
Just diff <- runTask (diffBlobPair IdentityDiffRenderer sourceBlobs)
|
||||
diffTOC diff `shouldBe`
|
||||
[ JSONSummary $ Summarizable C.Function "performHealthCheck" (sourceSpanBetween (8, 1) (29, 2)) "modified" ]
|
||||
[ JSONSummary "Function" "performHealthCheck" (sourceSpanBetween (8, 1) (29, 2)) "modified" ]
|
||||
|
||||
it "summarizes Go methods with receivers with special formatting" $ do
|
||||
sourceBlobs <- blobsForPaths (both "go/method-with-receiver.A.go" "go/method-with-receiver.B.go")
|
||||
Just diff <- runTask (diffBlobPair IdentityDiffRenderer sourceBlobs)
|
||||
diffTOC diff `shouldBe`
|
||||
[ JSONSummary $ Summarizable C.Method "(*apiClient) CheckAuth" (sourceSpanBetween (3,1) (3,101)) "added" ]
|
||||
[ JSONSummary "Method" "(*apiClient) CheckAuth" (sourceSpanBetween (3,1) (3,101)) "added" ]
|
||||
|
||||
it "summarizes Ruby methods that start with two identifiers" $ do
|
||||
sourceBlobs <- blobsForPaths (both "ruby/method-starts-with-two-identifiers.A.rb" "ruby/method-starts-with-two-identifiers.B.rb")
|
||||
Just diff <- runTask (diffBlobPair IdentityDiffRenderer sourceBlobs)
|
||||
diffTOC diff `shouldBe`
|
||||
[ JSONSummary $ Summarizable C.Method "foo" (sourceSpanBetween (1, 1) (4, 4)) "modified" ]
|
||||
[ JSONSummary "Method" "foo" (sourceSpanBetween (1, 1) (4, 4)) "modified" ]
|
||||
|
||||
it "handles unicode characters in file" $ do
|
||||
sourceBlobs <- blobsForPaths (both "ruby/unicode.A.rb" "ruby/unicode.B.rb")
|
||||
Just diff <- runTask (diffBlobPair IdentityDiffRenderer sourceBlobs)
|
||||
diffTOC diff `shouldBe`
|
||||
[ JSONSummary $ Summarizable C.Method "foo" (sourceSpanBetween (6, 1) (7, 4)) "added" ]
|
||||
[ JSONSummary "Method" "foo" (sourceSpanBetween (6, 1) (7, 4)) "added" ]
|
||||
|
||||
prop "inserts of methods and functions are summarized" $
|
||||
\name body ->
|
||||
@ -124,12 +124,12 @@ spec = parallel $ do
|
||||
diffTOC (diffTerms (pure term)) `shouldBe` []
|
||||
|
||||
describe "JSONSummary" $ do
|
||||
it "encodes InSummarizable to JSON" $ do
|
||||
let summary = JSONSummary $ Summarizable C.Method "foo" (sourceSpanBetween (1, 1) (4, 4)) "modified"
|
||||
it "encodes modified summaries to JSON" $ do
|
||||
let summary = JSONSummary "Method" "foo" (sourceSpanBetween (1, 1) (4, 4)) "modified"
|
||||
encode summary `shouldBe` "{\"span\":{\"start\":[1,1],\"end\":[4,4]},\"category\":\"Method\",\"term\":\"foo\",\"changeType\":\"modified\"}"
|
||||
|
||||
it "encodes Summarizable to JSON" $ do
|
||||
let summary = JSONSummary $ Summarizable C.SingletonMethod "self.foo" (sourceSpanBetween (1, 1) (2, 4)) "added"
|
||||
it "encodes added summaries to JSON" $ do
|
||||
let summary = JSONSummary "Method" "self.foo" (sourceSpanBetween (1, 1) (2, 4)) "added"
|
||||
encode summary `shouldBe` "{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"category\":\"Method\",\"term\":\"self.foo\",\"changeType\":\"added\"}"
|
||||
|
||||
describe "diff with ToCDiffRenderer" $ do
|
||||
|
Loading…
Reference in New Issue
Block a user