1
1
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:
Timothy Clem 2017-06-06 13:31:16 -07:00 committed by GitHub
commit a75e7646b4
12 changed files with 339 additions and 149 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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.

View File

@ -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)

View File

@ -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 Rubys grammar onto a program in Rubys 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)

View File

@ -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

View File

@ -9,6 +9,7 @@ module Renderer
, renderJSONTerm
, renderToC
, declarationAlgebra
, syntaxDeclarationAlgebra
, identifierAlgebra
, Summaries(..)
, File(..)

View 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 declarations 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

View File

@ -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

View File

@ -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 nodes 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

View File

@ -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