mirror of
https://github.com/github/semantic.git
synced 2024-11-28 10:15:55 +03:00
Merge branch 'master' into update-go-assignment
This commit is contained in:
commit
e56ec0a416
@ -23,7 +23,6 @@ library
|
||||
-- Semantic assignment
|
||||
, Assigning.Assignment
|
||||
, Assigning.Assignment.Table
|
||||
, Category
|
||||
-- General datatype definitions & generic algorithms
|
||||
, Data.Algebra
|
||||
, Data.Align.Generic
|
||||
@ -58,11 +57,9 @@ library
|
||||
, Diffing.Algorithm.RWS.FeatureVector
|
||||
, Diffing.Algorithm.SES
|
||||
, Diffing.Interpreter
|
||||
, Info
|
||||
-- Language-specific grammar/syntax types, & assignments
|
||||
, Language.Markdown.Assignment
|
||||
, Language.Markdown.Syntax
|
||||
, Language.Go
|
||||
, Language.Go.Grammar
|
||||
, Language.Go.Assignment
|
||||
, Language.Go.Syntax
|
||||
@ -98,7 +95,6 @@ library
|
||||
, Semantic.Task
|
||||
, Semantic.Queue
|
||||
, Semantic.Util
|
||||
, Syntax
|
||||
build-depends: base >= 4.8 && < 5
|
||||
, aeson
|
||||
, ansi-terminal
|
||||
|
@ -3,7 +3,6 @@ module Analysis.Declaration
|
||||
( Declaration(..)
|
||||
, HasDeclaration
|
||||
, declarationAlgebra
|
||||
, syntaxDeclarationAlgebra
|
||||
) where
|
||||
|
||||
import Data.Algebra
|
||||
@ -24,9 +23,7 @@ import Data.Term
|
||||
import qualified Data.Text as T
|
||||
import Data.Union
|
||||
import GHC.Generics
|
||||
import Info (byteRange, sourceSpan)
|
||||
import qualified Language.Markdown.Syntax as Markdown
|
||||
import qualified Syntax as S
|
||||
|
||||
-- | A declaration’s identifier and type.
|
||||
data Declaration
|
||||
@ -78,46 +75,46 @@ class CustomHasDeclaration syntax where
|
||||
instance CustomHasDeclaration Markdown.Heading where
|
||||
customToDeclaration Blob{..} ann (Markdown.Heading level terms _)
|
||||
= Just $ HeadingDeclaration (headingText terms) mempty blobLanguage level
|
||||
where headingText terms = getSource $ maybe (byteRange ann) sconcat (nonEmpty (headingByteRange <$> toList terms))
|
||||
headingByteRange (Term (In ann _), _) = byteRange ann
|
||||
where headingText terms = getSource $ maybe (getField ann) sconcat (nonEmpty (headingByteRange <$> toList terms))
|
||||
headingByteRange (Term (In ann _), _) = getField ann
|
||||
getSource = firstLine . toText . flip Source.slice blobSource
|
||||
firstLine = T.takeWhile (/= '\n')
|
||||
|
||||
-- | Produce an 'ErrorDeclaration' for 'Syntax.Error' nodes.
|
||||
instance CustomHasDeclaration Syntax.Error where
|
||||
customToDeclaration Blob{..} ann err@Syntax.Error{}
|
||||
= Just $ ErrorDeclaration (T.pack (formatTOCError (Syntax.unError (sourceSpan ann) err))) mempty blobLanguage
|
||||
= Just $ ErrorDeclaration (T.pack (formatTOCError (Syntax.unError (getField ann) err))) mempty blobLanguage
|
||||
where formatTOCError e = showExpectation False (errorExpected e) (errorActual e) ""
|
||||
|
||||
-- | Produce a 'FunctionDeclaration' for 'Declaration.Function' nodes so long as their identifier is non-empty (defined as having a non-empty 'byteRange').
|
||||
-- | Produce a 'FunctionDeclaration' for 'Declaration.Function' nodes so long as their identifier is non-empty (defined as having a non-empty 'Range').
|
||||
instance CustomHasDeclaration Declaration.Function where
|
||||
customToDeclaration blob@Blob{..} ann decl@(Declaration.Function _ (Term (In identifierAnn _), _) _ _)
|
||||
-- Do not summarize anonymous functions
|
||||
| isEmpty identifierAnn = Nothing
|
||||
-- Named functions
|
||||
| otherwise = Just $ FunctionDeclaration (getSource identifierAnn) (getFunctionSource blob (In ann decl)) blobLanguage
|
||||
where getSource = toText . flip Source.slice blobSource . byteRange
|
||||
isEmpty = (== 0) . rangeLength . byteRange
|
||||
where getSource = toText . flip Source.slice blobSource . getField
|
||||
isEmpty = (== 0) . rangeLength . getField
|
||||
|
||||
-- | Produce a 'MethodDeclaration' for 'Declaration.Method' nodes. If the method’s receiver is non-empty (defined as having a non-empty 'byteRange'), the 'declarationIdentifier' will be formatted as 'receiver.method_name'; otherwise it will be simply 'method_name'.
|
||||
-- | Produce a 'MethodDeclaration' for 'Declaration.Method' nodes. If the method’s receiver is non-empty (defined as having a non-empty 'Range'), the 'declarationIdentifier' will be formatted as 'receiver.method_name'; otherwise it will be simply 'method_name'.
|
||||
instance CustomHasDeclaration Declaration.Method where
|
||||
customToDeclaration blob@Blob{..} ann decl@(Declaration.Method _ (Term (In receiverAnn receiverF), _) (Term (In identifierAnn _), _) _ _)
|
||||
-- Methods without a receiver
|
||||
| isEmpty receiverAnn = Just $ MethodDeclaration (getSource identifierAnn) (getMethodSource blob (In ann decl)) blobLanguage Nothing
|
||||
-- Methods with a receiver type and an identifier (e.g. (a *Type) in Go).
|
||||
| blobLanguage == Just Language.Go
|
||||
| blobLanguage == Just Go
|
||||
, [ _, Term (In receiverType _) ] <- toList receiverF = Just $ MethodDeclaration (getSource identifierAnn) (getMethodSource blob (In ann decl)) blobLanguage (Just (getSource receiverType))
|
||||
-- Methods with a receiver (class methods) are formatted like `receiver.method_name`
|
||||
| otherwise = Just $ MethodDeclaration (getSource identifierAnn) (getMethodSource blob (In ann decl)) blobLanguage (Just (getSource receiverAnn))
|
||||
where getSource = toText . flip Source.slice blobSource . byteRange
|
||||
isEmpty = (== 0) . rangeLength . byteRange
|
||||
where getSource = toText . flip Source.slice blobSource . getField
|
||||
isEmpty = (== 0) . rangeLength . getField
|
||||
|
||||
-- | Produce a 'ClassDeclaration' for 'Declaration.Class' nodes.
|
||||
instance CustomHasDeclaration Declaration.Class where
|
||||
customToDeclaration blob@Blob{..} ann decl@(Declaration.Class _ (Term (In identifierAnn _), _) _ _)
|
||||
-- Classes
|
||||
= Just $ ClassDeclaration (getSource identifierAnn) (getClassSource blob (In ann decl)) blobLanguage
|
||||
where getSource = toText . flip Source.slice blobSource . byteRange
|
||||
where getSource = toText . flip Source.slice blobSource . getField
|
||||
|
||||
-- | Produce a 'Declaration' for 'Union's using the 'HasDeclaration' instance & therefore using a 'CustomHasDeclaration' instance when one exists & the type is listed in 'DeclarationStrategy'.
|
||||
instance Apply HasDeclaration fs => CustomHasDeclaration (Union fs) where
|
||||
@ -158,46 +155,23 @@ instance CustomHasDeclaration syntax => HasDeclarationWithStrategy 'Custom synta
|
||||
toDeclarationWithStrategy _ = customToDeclaration
|
||||
|
||||
|
||||
-- | Compute 'Declaration's for methods and functions in 'Syntax'.
|
||||
syntaxDeclarationAlgebra :: HasField fields Range => Blob -> RAlgebra (Term S.Syntax (Record fields)) (Maybe Declaration)
|
||||
syntaxDeclarationAlgebra blob@Blob{..} decl@(In a r) = case r of
|
||||
S.Function (identifier, _) _ _ -> Just $ FunctionDeclaration (getSource identifier) (getSyntaxDeclarationSource blob decl) blobLanguage
|
||||
S.Method _ (identifier, _) Nothing _ _ -> Just $ MethodDeclaration (getSource identifier) (getSyntaxDeclarationSource blob decl) blobLanguage Nothing
|
||||
S.Method _ (identifier, _) (Just (receiver, _)) _ _
|
||||
| S.Indexed [receiverParams] <- termOut receiver
|
||||
, S.ParameterDecl (Just ty) _ <- termOut receiverParams -> Just $ MethodDeclaration (getSource identifier) (getSyntaxDeclarationSource blob decl) blobLanguage (Just (getSource ty))
|
||||
| otherwise -> Just $ MethodDeclaration (getSource identifier) (getSyntaxDeclarationSource blob decl) blobLanguage (Just (getSource receiver))
|
||||
S.ParseError{} -> Just $ ErrorDeclaration (toText (Source.slice (byteRange a) blobSource)) mempty blobLanguage
|
||||
_ -> Nothing
|
||||
where
|
||||
getSource = toText . flip Source.slice blobSource . byteRange . termAnnotation
|
||||
|
||||
getMethodSource :: HasField fields Range => Blob -> TermF Declaration.Method (Record fields) (Term syntax (Record fields), a) -> T.Text
|
||||
getMethodSource Blob{..} (In a r)
|
||||
= let declRange = byteRange a
|
||||
bodyRange = byteRange <$> case r of
|
||||
= let declRange = getField a
|
||||
bodyRange = getField <$> case r of
|
||||
Declaration.Method _ _ _ _ (Term (In a' _), _) -> Just a'
|
||||
in maybe mempty (T.stripEnd . toText . flip Source.slice blobSource . subtractRange declRange) bodyRange
|
||||
|
||||
getFunctionSource :: HasField fields Range => Blob -> TermF Declaration.Function (Record fields) (Term syntax (Record fields), a) -> T.Text
|
||||
getFunctionSource Blob{..} (In a r)
|
||||
= let declRange = byteRange a
|
||||
bodyRange = byteRange <$> case r of
|
||||
= let declRange = getField a
|
||||
bodyRange = getField <$> case r of
|
||||
Declaration.Function _ _ _ (Term (In a' _), _) -> Just a'
|
||||
in maybe mempty (T.stripEnd . toText . flip Source.slice blobSource . subtractRange declRange) bodyRange
|
||||
|
||||
getClassSource :: (HasField fields Range) => Blob -> TermF Declaration.Class (Record fields) (Term syntax (Record fields), a) -> T.Text
|
||||
getClassSource Blob{..} (In a r)
|
||||
= let declRange = byteRange a
|
||||
bodyRange = byteRange <$> case r of
|
||||
= let declRange = getField a
|
||||
bodyRange = getField <$> case r of
|
||||
Declaration.Class _ _ _ (Term (In a' _), _) -> Just a'
|
||||
in maybe mempty (T.stripEnd . toText . flip Source.slice blobSource . subtractRange declRange) bodyRange
|
||||
|
||||
getSyntaxDeclarationSource :: HasField fields Range => Blob -> TermF S.Syntax (Record fields) (Term syntax (Record fields), a) -> T.Text
|
||||
getSyntaxDeclarationSource Blob{..} (In a r)
|
||||
= let declRange = byteRange a
|
||||
bodyRange = byteRange <$> case r of
|
||||
S.Function _ _ ((Term (In a' _), _) : _) -> Just a'
|
||||
S.Method _ _ _ _ ((Term (In a' _), _) : _) -> Just a'
|
||||
_ -> Nothing
|
||||
in maybe mempty (T.stripEnd . toText . flip Source.slice blobSource . subtractRange declRange) bodyRange
|
||||
|
@ -1,7 +1,6 @@
|
||||
{-# LANGUAGE DataKinds, TypeOperators #-}
|
||||
module Analysis.Decorator
|
||||
( decoratorWithAlgebra
|
||||
, syntaxIdentifierAlgebra
|
||||
, constructorNameAndConstantFields
|
||||
) where
|
||||
|
||||
@ -9,14 +8,12 @@ import Data.Aeson
|
||||
import Data.Algebra
|
||||
import Data.Bifunctor (second)
|
||||
import Data.ByteString.Char8 (ByteString, pack)
|
||||
import Data.Foldable (asum)
|
||||
import Data.Functor.Classes (Show1 (liftShowsPrec))
|
||||
import Data.Functor.Foldable
|
||||
import Data.JSON.Fields
|
||||
import Data.Record
|
||||
import Data.Term
|
||||
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
|
||||
import qualified Syntax as S
|
||||
import Data.Text.Encoding (decodeUtf8)
|
||||
|
||||
-- | Lift an algebra into a decorator for terms annotated with records.
|
||||
decoratorWithAlgebra :: Functor syntax
|
||||
@ -32,24 +29,6 @@ newtype Identifier = Identifier ByteString
|
||||
instance ToJSONFields Identifier where
|
||||
toJSONFields (Identifier i) = [ "identifier" .= decodeUtf8 i ]
|
||||
|
||||
syntaxIdentifierAlgebra :: RAlgebra (Term S.Syntax a) (Maybe Identifier)
|
||||
syntaxIdentifierAlgebra (In _ syntax) = case syntax of
|
||||
S.Assignment f _ -> identifier f
|
||||
S.Class f _ _ -> identifier f
|
||||
S.Export f _ -> f >>= identifier
|
||||
S.Function f _ _ -> identifier f
|
||||
S.FunctionCall f _ _ -> identifier f
|
||||
S.Import f _ -> identifier f
|
||||
S.Method _ f _ _ _ -> identifier f
|
||||
S.MethodCall _ f _ _ -> identifier f
|
||||
S.Module f _ -> identifier f
|
||||
S.OperatorAssignment f _ -> identifier f
|
||||
S.SubscriptAccess f _ -> identifier f
|
||||
S.TypeDecl f _ -> identifier f
|
||||
S.VarAssignment f _ -> asum $ identifier <$> f
|
||||
_ -> Nothing
|
||||
where identifier = fmap (Identifier . encodeUtf8) . S.extractLeafValue . termOut . fst
|
||||
|
||||
-- | Compute a 'ByteString' label for a 'Show1'able 'Term'.
|
||||
--
|
||||
-- This uses 'liftShowsPrec' to produce the 'ByteString', with the effect that
|
||||
|
@ -108,12 +108,13 @@ import Data.Functor.Classes
|
||||
import Data.Ix (Ix(..))
|
||||
import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
|
||||
import Data.Maybe
|
||||
import Data.Range
|
||||
import Data.Record
|
||||
import Data.Semigroup
|
||||
import qualified Data.Source as Source (Source, slice, sourceBytes)
|
||||
import Data.Span
|
||||
import Data.Term
|
||||
import GHC.Stack
|
||||
import qualified Info
|
||||
import Prelude hiding (fail, until)
|
||||
import Text.Parser.Combinators as Parsers hiding (choice)
|
||||
import TreeSitter.Language
|
||||
@ -262,7 +263,7 @@ runAssignment source = \ assignment state -> go assignment state >>= requireExha
|
||||
|
||||
anywhere node = case runTracing t of
|
||||
End -> requireExhaustive (tracingCallSite t) ((), state) >>= uncurry yield
|
||||
Location -> yield (Info.Range stateOffset stateOffset :. Info.Span statePos statePos :. Nil) state
|
||||
Location -> yield (Range stateOffset stateOffset :. Span statePos statePos :. Nil) state
|
||||
Many rule -> fix (\ recur state -> (go rule state >>= \ (a, state') -> first (a:) <$> if state == state' then pure ([], state') else recur state') `catchError` const (pure ([], state))) state >>= uncurry yield
|
||||
Alt (a:as) -> sconcat (flip yield state <$> a:|as)
|
||||
Label child label -> go child state `catchError` (\ err -> throwError err { errorExpected = [Left label] }) >>= uncurry yield
|
||||
@ -274,7 +275,7 @@ runAssignment source = \ assignment state -> go assignment state >>= requireExha
|
||||
(Choose table _ _, State { stateNodes = Term (In node _) : _ }) | symbolType (nodeSymbol node) /= Regular, symbols@(_:_) <- Table.tableAddresses table, all ((== Regular) . symbolType) symbols -> skipTokens initialState
|
||||
_ -> initialState
|
||||
expectedSymbols = firstSet (t `Then` return)
|
||||
makeError = withStateCallStack (tracingCallSite t) state $ maybe (Error (Info.Span statePos statePos) (fmap Right expectedSymbols) Nothing) (nodeError (fmap Right expectedSymbols))
|
||||
makeError = withStateCallStack (tracingCallSite t) state $ maybe (Error (Span statePos statePos) (fmap Right expectedSymbols) Nothing) (nodeError (fmap Right expectedSymbols))
|
||||
|
||||
requireExhaustive :: Symbol grammar => Maybe (String, SrcLoc) -> (result, State ast grammar) -> Either (Error (Either String grammar)) (result, State ast grammar)
|
||||
requireExhaustive callSite (a, state) = let state' = skipTokens state in case stateNodes state' of
|
||||
@ -290,13 +291,13 @@ skipTokens state = state { stateNodes = dropWhile ((/= Regular) . symbolType . n
|
||||
-- | Advances the state past the current (head) node (if any), dropping it off stateNodes, and updating stateOffset & statePos to its end; or else returns the state unchanged.
|
||||
advanceState :: State ast grammar -> State ast grammar
|
||||
advanceState state@State{..}
|
||||
| Term (In Node{..} _) : rest <- stateNodes = State (Info.end nodeByteRange) (Info.spanEnd nodeSpan) stateCallSites rest
|
||||
| Term (In Node{..} _) : rest <- stateNodes = State (end nodeByteRange) (spanEnd nodeSpan) stateCallSites rest
|
||||
| otherwise = state
|
||||
|
||||
-- | State kept while running 'Assignment's.
|
||||
data State ast grammar = State
|
||||
{ stateOffset :: {-# UNPACK #-} !Int -- ^ The offset into the Source thus far reached, measured in bytes.
|
||||
, statePos :: {-# UNPACK #-} !Info.Pos -- ^ The (1-indexed) line/column position in the Source thus far reached.
|
||||
, statePos :: {-# UNPACK #-} !Pos -- ^ The (1-indexed) line/column position in the Source thus far reached.
|
||||
, stateCallSites :: ![(String, SrcLoc)] -- ^ The symbols & source locations of the calls thus far.
|
||||
, stateNodes :: ![AST ast grammar] -- ^ The remaining nodes to assign. Note that 'children' rules recur into subterms, and thus this does not necessarily reflect all of the terms remaining to be assigned in the overall algorithm, only those “in scope.”
|
||||
}
|
||||
@ -305,7 +306,7 @@ deriving instance (Eq grammar, Eq1 ast) => Eq (State ast grammar)
|
||||
deriving instance (Show grammar, Show1 ast) => Show (State ast grammar)
|
||||
|
||||
makeState :: [AST ast grammar] -> State ast grammar
|
||||
makeState = State 0 (Info.Pos 1 1) []
|
||||
makeState = State 0 (Pos 1 1) []
|
||||
|
||||
|
||||
-- Instances
|
||||
@ -378,7 +379,7 @@ instance Show1 f => Show1 (Tracing f) where
|
||||
instance (Enum grammar, Ix grammar, Show grammar, Show1 ast) => Show1 (AssignmentF ast grammar) where
|
||||
liftShowsPrec sp sl d a = case a of
|
||||
End -> showString "End" . showChar ' ' . sp d ()
|
||||
Location -> showString "Location" . sp d (Info.Range 0 0 :. Info.Span (Info.Pos 1 1) (Info.Pos 1 1) :. Nil)
|
||||
Location -> showString "Location" . sp d (Range 0 0 :. Span (Pos 1 1) (Pos 1 1) :. Nil)
|
||||
CurrentNode -> showString "CurrentNode"
|
||||
Source -> showString "Source" . showChar ' ' . sp d ""
|
||||
Children a -> showsUnaryWith showChild "Children" d a
|
||||
|
250
src/Category.hs
250
src/Category.hs
@ -1,250 +0,0 @@
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# OPTIONS_GHC -funbox-strict-fields #-}
|
||||
module Category where
|
||||
|
||||
import Data.Aeson
|
||||
import Data.Hashable
|
||||
import Data.JSON.Fields
|
||||
import Data.Text (Text, pack)
|
||||
import GHC.Generics
|
||||
|
||||
-- | A standardized category of AST node. Used to determine the semantics for
|
||||
-- | semantic diffing and define comparability of nodes.
|
||||
data Category
|
||||
-- | The top-level branch node.
|
||||
= Program
|
||||
-- | A node indicating syntax errors.
|
||||
| ParseError
|
||||
-- | A boolean expression.
|
||||
| Boolean
|
||||
-- | A bitwise operator.
|
||||
| BitwiseOperator
|
||||
-- | A boolean operator (e.g. ||, &&).
|
||||
| BooleanOperator
|
||||
-- | A literal key-value data structure.
|
||||
| DictionaryLiteral
|
||||
-- | A pair, e.g. of a key & value
|
||||
| Pair
|
||||
-- | A call to a function.
|
||||
| FunctionCall
|
||||
-- | A function declaration.
|
||||
| Function
|
||||
-- | An identifier.
|
||||
| Identifier
|
||||
-- | A function's parameters.
|
||||
| Params
|
||||
-- | A function's expression statements.
|
||||
| ExpressionStatements
|
||||
-- | A method call on an object.
|
||||
| MethodCall
|
||||
-- | A method's arguments.
|
||||
| Args
|
||||
-- | A string literal.
|
||||
| StringLiteral
|
||||
-- | An integer literal.
|
||||
| IntegerLiteral
|
||||
-- | A regex literal.
|
||||
| Regex
|
||||
-- | A return statement.
|
||||
| Return
|
||||
-- | A symbol literal.
|
||||
| SymbolLiteral
|
||||
-- | A template string literal.
|
||||
| TemplateString
|
||||
-- | An array literal.
|
||||
| ArrayLiteral
|
||||
-- | An assignment expression.
|
||||
| Assignment
|
||||
-- | A math assignment expression.
|
||||
| MathAssignment
|
||||
-- | A member access expression.
|
||||
| MemberAccess
|
||||
-- | A subscript access expression.
|
||||
| SubscriptAccess
|
||||
-- | A variable assignment within a variable declaration.
|
||||
| VarAssignment
|
||||
-- | A variable declaration.
|
||||
| VarDecl
|
||||
-- | A switch expression.
|
||||
| Switch
|
||||
-- | A if/else expression.
|
||||
| If
|
||||
-- | A for expression.
|
||||
| For
|
||||
-- | A while expression.
|
||||
| While
|
||||
-- | A do/while expression.
|
||||
| DoWhile
|
||||
-- | A ternary expression.
|
||||
| Ternary
|
||||
-- | A case expression.
|
||||
| Case
|
||||
-- | An expression with an operator.
|
||||
| Operator
|
||||
-- | An comma operator expression
|
||||
| CommaOperator
|
||||
-- | An object/dictionary/hash literal.
|
||||
| Object
|
||||
-- | A throw statement.
|
||||
| Throw
|
||||
-- | A constructor statement, e.g. new Foo;
|
||||
| Constructor
|
||||
-- | A try statement.
|
||||
| Try
|
||||
-- | A catch statement.
|
||||
| Catch
|
||||
-- | A finally statement.
|
||||
| Finally
|
||||
-- | A class declaration.
|
||||
| Class
|
||||
-- | A class method declaration.
|
||||
| Method
|
||||
-- | A comment.
|
||||
| Comment
|
||||
-- | A non-standard category, which can be used for comparability.
|
||||
| Other Text
|
||||
-- | A relational operator (e.g. < or >=)
|
||||
| RelationalOperator
|
||||
-- | An empty statement. (e.g. ; in JavaScript)
|
||||
| Empty
|
||||
-- | A number literal.
|
||||
| NumberLiteral
|
||||
-- | A mathematical operator (e.g. +, -, *, /).
|
||||
| MathOperator
|
||||
-- | A module
|
||||
| Module
|
||||
-- | A namespace in TypeScript.
|
||||
| Namespace
|
||||
-- | An interface
|
||||
| Interface
|
||||
-- | An import
|
||||
| Import
|
||||
-- | An export
|
||||
| Export
|
||||
-- | An anonymous function.
|
||||
| AnonymousFunction
|
||||
-- | An interpolation (e.g. "#{bar}" in Ruby)
|
||||
| Interpolation
|
||||
-- | A subshell command (e.g. `ls -la` in Ruby)
|
||||
| Subshell
|
||||
-- | Operator assignment, e.g. a ||= b, a += 1 in Ruby.
|
||||
| OperatorAssignment
|
||||
-- | A yield statement.
|
||||
| Yield
|
||||
-- | An until expression.
|
||||
| Until
|
||||
-- | A unless/else expression.
|
||||
| Unless
|
||||
| Begin
|
||||
| Else
|
||||
| Elsif
|
||||
| Ensure
|
||||
| Rescue
|
||||
-- | Formerly used for Ruby’s @x rescue y@ modifier syntax. Deprecated. Use @Modifier Rescue@ instead. Left in place to preserve hashing & RWS results.
|
||||
| RescueModifier
|
||||
| RescuedException
|
||||
| RescueArgs
|
||||
| When
|
||||
| Negate
|
||||
-- | A select expression in Go.
|
||||
| Select
|
||||
| Defer
|
||||
| Go
|
||||
| Slice
|
||||
| TypeAssertion
|
||||
| TypeConversion
|
||||
-- | An argument pair, e.g. foo(run: true) or foo(:run => true) in Ruby.
|
||||
| ArgumentPair
|
||||
-- | A keyword parameter, e.g. def foo(name:) or def foo(name:false) in Ruby.
|
||||
| KeywordParameter
|
||||
-- | An optional/default parameter, e.g. def foo(name = nil) in Ruby.
|
||||
| OptionalParameter
|
||||
-- | A splat parameter, e.g. def foo(*array) in Ruby.
|
||||
| SplatParameter
|
||||
-- | A hash splat parameter, e.g. def foo(**option) in Ruby.
|
||||
| HashSplatParameter
|
||||
-- | A block parameter, e.g. def foo(&block) in Ruby.
|
||||
| BlockParameter
|
||||
-- | A float literal.
|
||||
| FloatLiteral
|
||||
-- | An array type declaration, e.g. [2]string in Go.
|
||||
| ArrayTy
|
||||
-- | A dictionary type declaration, e.g. map[string] in Go.
|
||||
| DictionaryTy
|
||||
-- | A Struct type declaration, struct Foo {..} in Go.
|
||||
| StructTy
|
||||
-- | A Struct constructor, e.g. foo = Foo {..} in Go.
|
||||
| Struct
|
||||
-- | A break statement, e.g. break; in JavaScript.
|
||||
| Break
|
||||
-- | A continue statement, e.g. continue; in JavaScript.
|
||||
| Continue
|
||||
-- | A binary statement, e.g. a | b in Ruby.
|
||||
| Binary
|
||||
-- | A unary statement, e.g. !a in Ruby.
|
||||
| Unary
|
||||
-- | A constant, e.g `Foo::Bar` in Ruby.
|
||||
| Constant
|
||||
-- | A superclass, e.g `< Foo` in Ruby.
|
||||
| Superclass
|
||||
-- | A singleton class declaration, e.g. `class << self;end` in Ruby
|
||||
| SingletonClass
|
||||
-- | A range expression, e.g. `1..10` in Ruby.
|
||||
| RangeExpression
|
||||
-- | A scope resolution operator, e.g. `Foo::bar` in Ruby.
|
||||
| ScopeOperator
|
||||
-- | A BEGIN {} block of statements.
|
||||
| BeginBlock
|
||||
-- | An END {} block of statements.
|
||||
| EndBlock
|
||||
| ParameterDecl
|
||||
-- | A default case in a switch statement.
|
||||
| DefaultCase
|
||||
-- | A type declaration.
|
||||
| TypeDecl
|
||||
| PointerTy
|
||||
-- | A field declaration.
|
||||
| FieldDecl
|
||||
-- | A slice type, e.g. []string{"hello"} in Go.
|
||||
| SliceTy
|
||||
-- | An element of a slice literal.
|
||||
| Element
|
||||
-- | A literal value.
|
||||
| Literal
|
||||
-- | A channel type in Go.
|
||||
| ChannelTy
|
||||
-- | A send statement in Go.
|
||||
| Send
|
||||
-- | An Index expression, e.g. x[1] in Go.
|
||||
| IndexExpression
|
||||
-- | A function type.
|
||||
| FunctionTy
|
||||
-- | An increment statement, e.g. i++ in Go.
|
||||
| IncrementStatement
|
||||
-- | A decrement statement, e.g. i-- in Go.
|
||||
| DecrementStatement
|
||||
-- | A qualified identifier, e.g. Module.function in Go.
|
||||
| QualifiedType
|
||||
| FieldDeclarations
|
||||
-- | A Go rune literal.
|
||||
| RuneLiteral
|
||||
-- | A modifier version of another Category, e.g. Ruby’s trailing @if@, @while@, etc. terms, whose subterms are swapped relative to regular @if@, @while@, etc. terms.
|
||||
| Modifier Category
|
||||
-- | A singleton method declaration, e.g. `def self.foo;end` in Ruby
|
||||
| SingletonMethod
|
||||
-- | An arbitrary type annotation.
|
||||
| Ty
|
||||
| ParenthesizedExpression
|
||||
| ParenthesizedType
|
||||
deriving (Eq, Generic, Ord, Show)
|
||||
|
||||
{-# DEPRECATED RescueModifier "Deprecated; use Modifier Rescue instead." #-}
|
||||
|
||||
|
||||
-- Instances
|
||||
|
||||
instance Hashable Category
|
||||
|
||||
instance ToJSONFields Category where
|
||||
toJSONFields c = ["category" .= case c of { Other s -> s ; _ -> pack (show c) }]
|
@ -3,6 +3,7 @@ module Data.Diff
|
||||
( Diff(..)
|
||||
, DiffF(..)
|
||||
, replacing
|
||||
, replaceF
|
||||
, inserting
|
||||
, insertF
|
||||
, deleting
|
||||
@ -44,7 +45,11 @@ data DiffF syntax ann1 ann2 recur
|
||||
|
||||
-- | Constructs a 'Diff' replacing one 'Term' with another recursively.
|
||||
replacing :: Functor syntax => Term syntax ann1 -> Term syntax ann2 -> Diff syntax ann1 ann2
|
||||
replacing (Term (In a1 r1)) (Term (In a2 r2)) = Diff (Patch (Replace (In a1 (deleting <$> r1)) (In a2 (inserting <$> r2))))
|
||||
replacing (Term (In a1 r1)) (Term (In a2 r2)) = replaceF (In a1 (deleting <$> r1)) (In a2 (inserting <$> r2))
|
||||
|
||||
-- | Constructs a 'Diff' replacing one 'TermF' populated by further 'Diff's with another.
|
||||
replaceF :: TermF syntax ann1 (Diff syntax ann1 ann2) -> TermF syntax ann2 (Diff syntax ann1 ann2) -> Diff syntax ann1 ann2
|
||||
replaceF t1 t2 = Diff (Patch (Replace t1 t2))
|
||||
|
||||
-- | Constructs a 'Diff' inserting a 'Term' recursively.
|
||||
inserting :: Functor syntax => Term syntax ann2 -> Diff syntax ann1 ann2
|
||||
|
@ -1,9 +1,9 @@
|
||||
module Data.SplitDiff where
|
||||
|
||||
import Control.Monad.Free
|
||||
import Data.Range
|
||||
import Data.Record
|
||||
import Data.Term
|
||||
import Info
|
||||
|
||||
-- | A patch to only one side of a diff.
|
||||
data SplitPatch a
|
||||
@ -14,7 +14,7 @@ data SplitPatch a
|
||||
|
||||
-- | Get the range of a SplitDiff.
|
||||
getRange :: Functor f => HasField fields Range => SplitDiff f (Record fields) -> Range
|
||||
getRange diff = byteRange $ case diff of
|
||||
getRange diff = getField $ case diff of
|
||||
Free annotated -> termFAnnotation annotated
|
||||
Pure patch -> termAnnotation (splitTerm patch)
|
||||
|
||||
|
@ -1,7 +1,6 @@
|
||||
{-# LANGUAGE DataKinds, GADTs, RankNTypes, ScopedTypeVariables, TypeOperators #-}
|
||||
module Diffing.Interpreter
|
||||
( diffTerms
|
||||
, diffSyntaxTerms
|
||||
) where
|
||||
|
||||
import Analysis.Decorator
|
||||
@ -10,88 +9,36 @@ import Control.Monad.Free.Freer
|
||||
import Data.Align.Generic
|
||||
import Data.Diff
|
||||
import Data.Functor.Classes
|
||||
import Data.Hashable (Hashable)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Record
|
||||
import Data.Term
|
||||
import Data.Text (Text)
|
||||
import Diffing.Algorithm
|
||||
import Diffing.Algorithm.RWS
|
||||
import Info hiding (Empty, Return)
|
||||
import Syntax (Syntax(Leaf))
|
||||
|
||||
|
||||
-- | Diff two Syntax terms recursively.
|
||||
diffSyntaxTerms :: (HasField fields1 Category, HasField fields2 Category)
|
||||
=> Term Syntax (Record fields1) -- ^ A term representing the old state.
|
||||
-> Term Syntax (Record fields2) -- ^ A term representing the new state.
|
||||
-> Diff Syntax (Record fields1) (Record fields2)
|
||||
diffSyntaxTerms = decoratingWith comparableByCategory (equalTerms comparableByCategory) getLabel getLabel
|
||||
|
||||
-- | Diff two à la carte terms recursively.
|
||||
diffTerms :: (Diffable syntax, Eq1 syntax, Foldable syntax, Functor syntax, GAlign syntax, Show1 syntax, Traversable syntax)
|
||||
=> Term syntax (Record fields1)
|
||||
-> Term syntax (Record fields2)
|
||||
-> Diff syntax (Record fields1) (Record fields2)
|
||||
diffTerms = decoratingWith comparableTerms equivalentTerms constructorNameAndConstantFields constructorNameAndConstantFields
|
||||
|
||||
-- | Diff two terms by decorating with feature vectors computed using the supplied labelling algebra, and stripping the feature vectors from the resulting diff.
|
||||
decoratingWith :: (Hashable label, Diffable syntax, GAlign syntax, Traversable syntax)
|
||||
=> ComparabilityRelation syntax (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2)) -- ^ A relation on terms used to determine comparability and equality.
|
||||
-> (Term syntax (Record (FeatureVector ': fields1)) -> Term syntax (Record (FeatureVector ': fields2)) -> Bool) -- ^ A relation used to determine term equivalence.
|
||||
-> (forall a. TermF syntax (Record fields1) a -> label)
|
||||
-> (forall a. TermF syntax (Record fields2) a -> label)
|
||||
-> Term syntax (Record fields1)
|
||||
-> Term syntax (Record fields2)
|
||||
-> Diff syntax (Record fields1) (Record fields2)
|
||||
decoratingWith comparability equivalence getLabel1 getLabel2 t1 t2 = stripDiff (diffTermsWith comparability equivalence (defaultFeatureVectorDecorator getLabel1 t1) (defaultFeatureVectorDecorator getLabel2 t2))
|
||||
|
||||
-- | Diff a pair of terms recurisvely, using the supplied continuation and 'ComparabilityRelation'.
|
||||
diffTermsWith :: forall syntax fields1 fields2
|
||||
. (Diffable syntax, GAlign syntax, Traversable syntax)
|
||||
=> ComparabilityRelation syntax (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2)) -- ^ A relation on terms used to determine comparability and equality.
|
||||
-> (Term syntax (Record (FeatureVector ': fields1)) -> Term syntax (Record (FeatureVector ': fields2)) -> Bool) -- ^ A relation used to determine term equivalence.
|
||||
-> Term syntax (Record (FeatureVector ': fields1)) -- ^ A term representing the old state.
|
||||
-> Term syntax (Record (FeatureVector ': fields2)) -- ^ A term representing the new state.
|
||||
-> Diff syntax (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2)) -- ^ The resulting diff.
|
||||
diffTermsWith comparable eqTerms t1 t2 = fromMaybe (replacing t1 t2) (runAlgorithm comparable eqTerms (diff t1 t2))
|
||||
diffTerms t1 t2 = stripDiff (fromMaybe (replacing t1' t2') (runAlgorithm (diff t1' t2')))
|
||||
where (t1', t2') = ( defaultFeatureVectorDecorator constructorNameAndConstantFields t1
|
||||
, defaultFeatureVectorDecorator constructorNameAndConstantFields t2)
|
||||
|
||||
-- | Run an 'Algorithm' to completion in an 'Alternative' context using the supplied comparability & equivalence relations.
|
||||
runAlgorithm :: forall syntax fields1 fields2 m result
|
||||
. (Diffable syntax, GAlign syntax, Traversable syntax, Alternative m, Monad m)
|
||||
=> ComparabilityRelation syntax (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2)) -- ^ A relation on terms used to determine comparability and equality.
|
||||
-> (Term syntax (Record (FeatureVector ': fields1)) -> Term syntax (Record (FeatureVector ': fields2)) -> Bool) -- ^ A relation used to determine term equivalence.
|
||||
-> Algorithm
|
||||
. (Diffable syntax, Eq1 syntax, GAlign syntax, Traversable syntax, Alternative m, Monad m)
|
||||
=> Algorithm
|
||||
(Term syntax (Record (FeatureVector ': fields1)))
|
||||
(Term syntax (Record (FeatureVector ': fields2)))
|
||||
(Diff syntax (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2)))
|
||||
result
|
||||
-> m result
|
||||
runAlgorithm comparable eqTerms = go
|
||||
where go :: forall result
|
||||
. Algorithm
|
||||
(Term syntax (Record (FeatureVector ': fields1)))
|
||||
(Term syntax (Record (FeatureVector ': fields2)))
|
||||
(Diff syntax (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2)))
|
||||
result
|
||||
-> m result
|
||||
go = iterFreerA (\ yield step -> case step of
|
||||
Diffing.Algorithm.Diff t1 t2 -> go (algorithmForTerms t1 t2) <|> pure (replacing t1 t2) >>= yield
|
||||
Linear (Term (In ann1 f1)) (Term (In ann2 f2)) -> merge (ann1, ann2) <$> galignWith (go . diffThese) f1 f2 >>= yield
|
||||
RWS as bs -> traverse (go . diffThese) (rws comparable eqTerms as bs) >>= yield
|
||||
Delete a -> yield (deleting a)
|
||||
Insert b -> yield (inserting b)
|
||||
Replace a b -> yield (replacing a b)
|
||||
Empty -> empty
|
||||
Alt a b -> yield a <|> yield b)
|
||||
|
||||
-- | Compute the label for a given term, suitable for inclusion in a _p_,_q_-gram.
|
||||
getLabel :: HasField fields Category => TermF Syntax (Record fields) a -> (Category, Maybe Text)
|
||||
getLabel (In h t) = (Info.category h, case t of
|
||||
Leaf s -> Just s
|
||||
_ -> Nothing)
|
||||
|
||||
|
||||
-- | Test whether two terms are comparable by their Category.
|
||||
comparableByCategory :: (HasField fields1 Category, HasField fields2 Category) => ComparabilityRelation syntax (Record fields1) (Record fields2)
|
||||
comparableByCategory (In a _) (In b _) = category a == category b
|
||||
runAlgorithm = iterFreerA (\ yield step -> case step of
|
||||
Diffing.Algorithm.Diff t1 t2 -> runAlgorithm (algorithmForTerms t1 t2) <|> pure (replacing t1 t2) >>= yield
|
||||
Linear (Term (In ann1 f1)) (Term (In ann2 f2)) -> merge (ann1, ann2) <$> galignWith (runAlgorithm . diffThese) f1 f2 >>= yield
|
||||
RWS as bs -> traverse (runAlgorithm . diffThese) (rws comparableTerms equivalentTerms as bs) >>= yield
|
||||
Delete a -> yield (deleting a)
|
||||
Insert b -> yield (inserting b)
|
||||
Replace a b -> yield (replacing a b)
|
||||
Empty -> empty
|
||||
Alt a b -> yield a <|> yield b)
|
||||
|
44
src/Info.hs
44
src/Info.hs
@ -1,44 +0,0 @@
|
||||
{-# LANGUAGE ConstraintKinds, DataKinds #-}
|
||||
module Info
|
||||
( DefaultFields
|
||||
, HasDefaultFields
|
||||
, Range(..)
|
||||
, byteRange
|
||||
, setByteRange
|
||||
, Category(..)
|
||||
, category
|
||||
, setCategory
|
||||
, Span(..)
|
||||
, Pos(..)
|
||||
, sourceSpan
|
||||
, setSpan
|
||||
) where
|
||||
|
||||
import Category
|
||||
import Data.Range
|
||||
import Data.Record
|
||||
import Data.Span
|
||||
|
||||
-- | The default set of fields produced by our parsers.
|
||||
type DefaultFields = '[ Range, Category, Span ]
|
||||
|
||||
-- | A type alias for HasField constraints commonly used throughout semantic-diff.
|
||||
type HasDefaultFields fields = (HasField fields Category, HasField fields Range, HasField fields Span)
|
||||
|
||||
byteRange :: HasField fields Range => Record fields -> Range
|
||||
byteRange = getField
|
||||
|
||||
setByteRange :: HasField fields Range => Record fields -> Range -> Record fields
|
||||
setByteRange = setField
|
||||
|
||||
category :: HasField fields Category => Record fields -> Category
|
||||
category = getField
|
||||
|
||||
setCategory :: HasField fields Category => Record fields -> Category -> Record fields
|
||||
setCategory = setField
|
||||
|
||||
sourceSpan :: HasField fields Span => Record fields -> Span
|
||||
sourceSpan = getField
|
||||
|
||||
setSpan :: HasField fields Span => Record fields -> Span -> Record fields
|
||||
setSpan = setField
|
@ -1,143 +0,0 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
module Language.Go where
|
||||
|
||||
import Data.Foldable (toList)
|
||||
import Data.Maybe
|
||||
import Data.Record
|
||||
import Data.Source
|
||||
import Data.Term
|
||||
import Data.Text
|
||||
import Info
|
||||
import qualified Syntax as S
|
||||
|
||||
termAssignment
|
||||
:: Source -- ^ The source of the term.
|
||||
-> Category -- ^ The category for the term.
|
||||
-> [ Term S.Syntax (Record DefaultFields) ] -- ^ The child nodes of the term.
|
||||
-> Maybe (S.Syntax (Term S.Syntax (Record DefaultFields))) -- ^ The resulting term, in Maybe.
|
||||
termAssignment source category children = case (category, children) of
|
||||
(Module, [moduleName]) -> Just $ S.Module moduleName []
|
||||
(Import, [importName]) -> Just $ S.Import importName []
|
||||
(Function, [id, params, block]) -> Just $ S.Function id [params] (toList (termOut block))
|
||||
(Function, [id, params, ty, block]) -> Just $ S.Function id [params, ty] (toList (termOut block))
|
||||
(For, [body]) | Other "block" <- Info.category (termAnnotation body) -> Just $ S.For [] (toList (termOut body))
|
||||
(For, [forClause, body]) | Other "for_clause" <- Info.category (termAnnotation forClause) -> Just $ S.For (toList (termOut forClause)) (toList (termOut body))
|
||||
(For, [rangeClause, body]) | Other "range_clause" <- Info.category (termAnnotation rangeClause) -> Just $ S.For (toList (termOut rangeClause)) (toList (termOut body))
|
||||
(TypeDecl, [identifier, ty]) -> Just $ S.TypeDecl identifier ty
|
||||
(StructTy, _) -> Just (S.Ty children)
|
||||
(FieldDecl, _) -> Just (S.FieldDecl children)
|
||||
(ParameterDecl, param : ty) -> Just $ S.ParameterDecl (listToMaybe ty) param
|
||||
(Assignment, [identifier, expression]) -> Just $ S.VarAssignment [identifier] expression
|
||||
(Select, _) -> Just $ S.Select (children >>= toList . termOut)
|
||||
(Go, [expr]) -> Just $ S.Go expr
|
||||
(Defer, [expr]) -> Just $ S.Defer expr
|
||||
(SubscriptAccess, [a, b]) -> Just $ S.SubscriptAccess a b
|
||||
(IndexExpression, [a, b]) -> Just $ S.SubscriptAccess a b
|
||||
(Slice, [a, rest]) -> Just $ S.SubscriptAccess a rest
|
||||
(Literal, children) -> Just . S.Indexed $ unpackElement <$> children
|
||||
(Other "composite_literal", [ty, values])
|
||||
| ArrayTy <- Info.category (termAnnotation ty)
|
||||
-> Just $ S.Array (Just ty) (toList (termOut values))
|
||||
| DictionaryTy <- Info.category (termAnnotation ty)
|
||||
-> Just $ S.Object (Just ty) (toList (termOut values))
|
||||
| SliceTy <- Info.category (termAnnotation ty)
|
||||
-> Just $ S.SubscriptAccess ty values
|
||||
(Other "composite_literal", []) -> Just $ S.Struct Nothing []
|
||||
(Other "composite_literal", [ty]) -> Just $ S.Struct (Just ty) []
|
||||
(Other "composite_literal", [ty, values]) -> Just $ S.Struct (Just ty) (toList (termOut values))
|
||||
(TypeAssertion, [a, b]) -> Just $ S.TypeAssertion a b
|
||||
(TypeConversion, [a, b]) -> Just $ S.TypeConversion a b
|
||||
-- TODO: Handle multiple var specs
|
||||
(VarAssignment, [identifier, expression]) -> Just $ S.VarAssignment [identifier] expression
|
||||
(VarDecl, children) -> Just $ S.VarDecl children
|
||||
(FunctionCall, id : rest) -> Just $ S.FunctionCall id [] rest
|
||||
(AnonymousFunction, [params, _, body])
|
||||
| [params'] <- toList (termOut params)
|
||||
-> Just $ S.AnonymousFunction (toList (termOut params')) (toList (termOut body))
|
||||
(PointerTy, _) -> Just $ S.Ty children
|
||||
(ChannelTy, _) -> Just $ S.Ty children
|
||||
(Send, [channel, expr]) -> Just $ S.Send channel expr
|
||||
(Operator, _) -> Just $ S.Operator children
|
||||
(FunctionTy, _) -> Just $ S.Ty children
|
||||
(IncrementStatement, _) -> Just $ S.Leaf (toText source)
|
||||
(DecrementStatement, _) -> Just $ S.Leaf (toText source)
|
||||
(QualifiedType, _) -> Just $ S.Leaf (toText source)
|
||||
(Method, [receiverParams, name, body]) -> Just (S.Method [] name (Just receiverParams) [] (toList (termOut body)))
|
||||
(Method, [receiverParams, name, params, body])
|
||||
-> Just (S.Method [] name (Just receiverParams) [params] (toList (termOut body)))
|
||||
(Method, [receiverParams, name, params, ty, body])
|
||||
-> Just (S.Method [] name (Just receiverParams) [params, ty] (toList (termOut body)))
|
||||
_ -> Nothing
|
||||
where unpackElement element
|
||||
| Element <- Info.category (termAnnotation element)
|
||||
, S.Indexed [ child ] <- termOut element = child
|
||||
| otherwise = element
|
||||
|
||||
categoryForGoName :: Text -> Category
|
||||
categoryForGoName name = case name of
|
||||
"identifier" -> Identifier
|
||||
"package_identifier" -> Identifier
|
||||
"type_identifier" -> Identifier
|
||||
"field_identifier" -> Identifier
|
||||
"label_name" -> Identifier
|
||||
"int_literal" -> NumberLiteral
|
||||
"float_literal" -> FloatLiteral
|
||||
"comment" -> Comment
|
||||
"return_statement" -> Return
|
||||
"interpreted_string_literal" -> StringLiteral
|
||||
"raw_string_literal" -> StringLiteral
|
||||
"binary_expression" -> RelationalOperator
|
||||
"function_declaration" -> Function
|
||||
"func_literal" -> AnonymousFunction
|
||||
"call_expression" -> FunctionCall
|
||||
"selector_expression" -> SubscriptAccess
|
||||
"index_expression" -> IndexExpression
|
||||
"slice_expression" -> Slice
|
||||
"parameters" -> Args
|
||||
"short_var_declaration" -> VarDecl
|
||||
"var_spec" -> VarAssignment
|
||||
"const_spec" -> VarAssignment
|
||||
"assignment_statement" -> Assignment
|
||||
"source_file" -> Program
|
||||
"package_clause" -> Module
|
||||
"if_statement" -> If
|
||||
"for_statement" -> For
|
||||
"expression_switch_statement" -> Switch
|
||||
"type_switch_statement" -> Switch
|
||||
"expression_case_clause" -> Case
|
||||
"type_case_clause" -> Case
|
||||
"select_statement" -> Select
|
||||
"communication_case" -> Case
|
||||
"defer_statement" -> Defer
|
||||
"go_statement" -> Go
|
||||
"type_assertion_expression" -> TypeAssertion
|
||||
"type_conversion_expression" -> TypeConversion
|
||||
"keyed_element" -> Pair
|
||||
"struct_type" -> StructTy
|
||||
"map_type" -> DictionaryTy
|
||||
"array_type" -> ArrayTy
|
||||
"implicit_length_array_type" -> ArrayTy
|
||||
"parameter_declaration" -> ParameterDecl
|
||||
"expression_case" -> Case
|
||||
"type_spec" -> TypeDecl
|
||||
"field_declaration" -> FieldDecl
|
||||
"pointer_type" -> PointerTy
|
||||
"slice_type" -> SliceTy
|
||||
"element" -> Element
|
||||
"literal_value" -> Literal
|
||||
"channel_type" -> ChannelTy
|
||||
"send_statement" -> Send
|
||||
"unary_expression" -> Operator
|
||||
"function_type" -> FunctionTy
|
||||
"inc_statement" -> IncrementStatement
|
||||
"dec_statement" -> DecrementStatement
|
||||
"qualified_type" -> QualifiedType
|
||||
"break_statement" -> Break
|
||||
"continue_statement" -> Continue
|
||||
"rune_literal" -> RuneLiteral
|
||||
"method_declaration" -> Method
|
||||
"import_spec" -> Import
|
||||
"block" -> ExpressionStatements
|
||||
"parenthesized_expression" -> ParenthesizedExpression
|
||||
"parenthesized_type" -> ParenthesizedType
|
||||
s -> Other s
|
@ -8,9 +8,10 @@ module Parsing.CMark
|
||||
import CMarkGFM
|
||||
import qualified Data.AST as A
|
||||
import Data.Ix
|
||||
import Data.Range
|
||||
import Data.Span
|
||||
import Data.Source
|
||||
import Data.Term
|
||||
import Info
|
||||
import TreeSitter.Language (Symbol(..), SymbolType(..))
|
||||
|
||||
data Grammar
|
||||
|
@ -4,8 +4,6 @@ module Parsing.Parser
|
||||
, SomeParser(..)
|
||||
, someParser
|
||||
, ApplyAll
|
||||
-- Syntax parsers
|
||||
, syntaxParserForLanguage
|
||||
-- À la carte parsers
|
||||
, goParser
|
||||
, jsonParser
|
||||
@ -27,20 +25,18 @@ import qualified Data.Syntax as Syntax
|
||||
import Data.Term
|
||||
import Data.Union
|
||||
import Foreign.Ptr
|
||||
import Info hiding (Empty, Go)
|
||||
import qualified Language.Go.Assignment as Go
|
||||
import qualified Language.JSON.Assignment as JSON
|
||||
import qualified Language.Markdown.Assignment as Markdown
|
||||
import qualified Language.Python.Assignment as Python
|
||||
import qualified Language.Ruby.Assignment as Ruby
|
||||
import qualified Language.TypeScript.Assignment as TypeScript
|
||||
import Syntax hiding (Go)
|
||||
import qualified TreeSitter.Language as TS (Language, Symbol)
|
||||
import TreeSitter.Go
|
||||
import TreeSitter.JSON
|
||||
import TreeSitter.Python
|
||||
import TreeSitter.Ruby
|
||||
import TreeSitter.TypeScript
|
||||
import TreeSitter.JSON
|
||||
|
||||
-- | A parser from 'Source' onto some term type.
|
||||
data Parser term where
|
||||
@ -51,8 +47,6 @@ data Parser term where
|
||||
=> Parser (Term ast (Node grammar)) -- ^ A parser producing AST.
|
||||
-> Assignment ast grammar (Term (Union fs) (Record Location)) -- ^ An assignment from AST onto 'Term's.
|
||||
-> Parser (Term (Union fs) (Record Location)) -- ^ A parser producing 'Term's.
|
||||
-- | A tree-sitter parser.
|
||||
TreeSitterParser :: Ptr TS.Language -> Parser (Term Syntax (Record DefaultFields))
|
||||
-- | A parser for 'Markdown' using cmark.
|
||||
MarkdownParser :: Parser (Term (TermF [] CMarkGFM.NodeType) (Node Markdown.Grammar))
|
||||
|
||||
@ -71,7 +65,7 @@ data SomeParser typeclasses ann where
|
||||
--
|
||||
-- This can be used to perform operations uniformly over terms produced by blobs with different 'Language's, and which therefore have different types in general. For example, given some 'Blob', we can parse and 'show' the parsed & assigned 'Term' like so:
|
||||
--
|
||||
-- > case someParser (Proxy :: Proxy '[Show1]) (blobLanguage language) of { Just (SomeParser parser) -> runTask (parse parser blob) >>= putStrLn . show ; _ -> return () }
|
||||
-- > case someParser (Proxy :: Proxy '[Show1]) <$> blobLanguage language of { Just (SomeParser parser) -> runTask (parse parser blob) >>= putStrLn . show ; _ -> return () }
|
||||
someParser :: ( ApplyAll typeclasses (Union Go.Syntax)
|
||||
, ApplyAll typeclasses (Union JSON.Syntax)
|
||||
, ApplyAll typeclasses (Union Markdown.Syntax)
|
||||
@ -79,28 +73,18 @@ someParser :: ( ApplyAll typeclasses (Union Go.Syntax)
|
||||
, ApplyAll typeclasses (Union Ruby.Syntax)
|
||||
, ApplyAll typeclasses (Union TypeScript.Syntax)
|
||||
)
|
||||
=> proxy typeclasses -- ^ A proxy for the list of typeclasses required, e.g. @(Proxy :: Proxy '[Show1])@.
|
||||
-> Language -- ^ The 'Language' to select.
|
||||
-> Maybe (SomeParser typeclasses (Record Location)) -- ^ 'Maybe' a 'SomeParser' abstracting the syntax type to be produced.
|
||||
someParser _ Go = Just (SomeParser goParser)
|
||||
someParser _ JavaScript = Just (SomeParser typescriptParser)
|
||||
someParser _ JSON = Just (SomeParser jsonParser)
|
||||
someParser _ JSX = Just (SomeParser typescriptParser)
|
||||
someParser _ Markdown = Just (SomeParser markdownParser)
|
||||
someParser _ Python = Just (SomeParser pythonParser)
|
||||
someParser _ Ruby = Just (SomeParser rubyParser)
|
||||
someParser _ TypeScript = Just (SomeParser typescriptParser)
|
||||
=> proxy typeclasses -- ^ A proxy for the list of typeclasses required, e.g. @(Proxy :: Proxy '[Show1])@.
|
||||
-> Language -- ^ The 'Language' to select.
|
||||
-> SomeParser typeclasses (Record Location) -- ^ A 'SomeParser' abstracting the syntax type to be produced.
|
||||
someParser _ Go = SomeParser goParser
|
||||
someParser _ JavaScript = SomeParser typescriptParser
|
||||
someParser _ JSON = SomeParser jsonParser
|
||||
someParser _ JSX = SomeParser typescriptParser
|
||||
someParser _ Markdown = SomeParser markdownParser
|
||||
someParser _ Python = SomeParser pythonParser
|
||||
someParser _ Ruby = SomeParser rubyParser
|
||||
someParser _ TypeScript = SomeParser typescriptParser
|
||||
|
||||
-- | Return a 'Language'-specific 'Parser', if one exists.
|
||||
syntaxParserForLanguage :: Language -> Maybe (Parser (Term Syntax (Record DefaultFields)))
|
||||
syntaxParserForLanguage language = case language of
|
||||
Go -> Just (TreeSitterParser tree_sitter_go)
|
||||
JavaScript -> Just (TreeSitterParser tree_sitter_typescript)
|
||||
JSON -> Just (TreeSitterParser tree_sitter_json)
|
||||
JSX -> Just (TreeSitterParser tree_sitter_typescript)
|
||||
Ruby -> Just (TreeSitterParser tree_sitter_ruby)
|
||||
TypeScript -> Just (TreeSitterParser tree_sitter_typescript)
|
||||
_ -> Nothing
|
||||
|
||||
goParser :: Parser Go.Term
|
||||
goParser = AssignmentParser (ASTParser tree_sitter_go) Go.assignment
|
||||
|
@ -1,45 +1,23 @@
|
||||
{-# LANGUAGE DataKinds, ScopedTypeVariables, TypeOperators #-}
|
||||
module Parsing.TreeSitter
|
||||
( treeSitterParser
|
||||
, parseToAST
|
||||
( parseToAST
|
||||
) where
|
||||
|
||||
import Category
|
||||
import Control.Exception
|
||||
import Control.Monad ((<=<))
|
||||
import Data.AST (AST, Node(Node))
|
||||
import Data.Blob
|
||||
import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
|
||||
import Data.Foldable (toList)
|
||||
import Data.Functor.Foldable hiding (Nil)
|
||||
import Data.Language as Language
|
||||
import Data.Range
|
||||
import Data.Record
|
||||
import Data.Source
|
||||
import Data.Span
|
||||
import Data.Term
|
||||
import Data.Text (Text, pack)
|
||||
import qualified Language.Go as Go
|
||||
import Foreign
|
||||
import Foreign.C.String (peekCString)
|
||||
import Foreign.Marshal.Array (allocaArray)
|
||||
import qualified Syntax as S
|
||||
import qualified TreeSitter.Document as TS
|
||||
import qualified TreeSitter.Node as TS
|
||||
import qualified TreeSitter.Language as TS
|
||||
import qualified TreeSitter.Go as TS
|
||||
import Info
|
||||
|
||||
-- | Returns a TreeSitter parser for the given language and TreeSitter grammar.
|
||||
treeSitterParser :: Ptr TS.Language -> Blob -> IO (Term S.Syntax (Record DefaultFields))
|
||||
treeSitterParser language blob = bracket TS.ts_document_new TS.ts_document_free $ \ document -> do
|
||||
TS.ts_document_set_language document language
|
||||
unsafeUseAsCStringLen (sourceBytes (blobSource blob)) $ \ (sourceBytes, len) -> do
|
||||
TS.ts_document_set_input_string_with_length document sourceBytes len
|
||||
TS.ts_document_parse_halt_on_error document
|
||||
term <- documentToTerm language document blob
|
||||
pure term
|
||||
|
||||
|
||||
-- | Parse 'Source' with the given 'TS.Language' and return its AST.
|
||||
parseToAST :: (Bounded grammar, Enum grammar) => Ptr TS.Language -> Blob -> IO (AST [] grammar)
|
||||
@ -66,131 +44,9 @@ anaM :: (Corecursive t, Monad m, Traversable (Base t)) => (a -> m (Base t a)) ->
|
||||
anaM g = a where a = pure . embed <=< traverse a <=< g
|
||||
|
||||
|
||||
-- | Return a parser for a tree sitter language & document.
|
||||
documentToTerm :: Ptr TS.Language -> Ptr TS.Document -> Blob -> IO (Term S.Syntax (Record DefaultFields))
|
||||
documentToTerm language document Blob{..} = do
|
||||
root <- alloca (\ rootPtr -> do
|
||||
TS.ts_document_root_node_p document rootPtr
|
||||
peek rootPtr)
|
||||
toTerm root
|
||||
where toTerm :: TS.Node -> IO (Term S.Syntax (Record DefaultFields))
|
||||
toTerm node@TS.Node{..} = do
|
||||
name <- peekCString nodeType
|
||||
|
||||
children <- getChildren (fromIntegral nodeNamedChildCount) copyNamed
|
||||
let allChildren = getChildren (fromIntegral nodeChildCount) copyAll
|
||||
|
||||
let source = slice (nodeRange node) blobSource
|
||||
assignTerm language source (range :. categoryForLanguageProductionName language (pack name) :. nodeSpan node :. Nil) children allChildren
|
||||
where getChildren count copy = do
|
||||
nodes <- allocaArray count $ \ childNodesPtr -> do
|
||||
_ <- with nodeTSNode (\ nodePtr -> copy nodePtr childNodesPtr (fromIntegral count))
|
||||
peekArray count childNodesPtr
|
||||
children <- traverse toTerm nodes
|
||||
return $! filter isNonEmpty children
|
||||
range = nodeRange node
|
||||
copyNamed = TS.ts_node_copy_named_child_nodes document
|
||||
copyAll = TS.ts_node_copy_child_nodes document
|
||||
|
||||
isNonEmpty :: HasField fields Category => Term S.Syntax (Record fields) -> Bool
|
||||
isNonEmpty = (/= Empty) . category . termAnnotation
|
||||
|
||||
nodeRange :: TS.Node -> Range
|
||||
nodeRange TS.Node{..} = Range (fromIntegral nodeStartByte) (fromIntegral nodeEndByte)
|
||||
|
||||
nodeSpan :: TS.Node -> Span
|
||||
nodeSpan TS.Node{..} = nodeStartPoint `seq` nodeEndPoint `seq` Span (pointPos nodeStartPoint) (pointPos nodeEndPoint)
|
||||
where pointPos TS.TSPoint{..} = pointRow `seq` pointColumn `seq` Pos (1 + fromIntegral pointRow) (1 + fromIntegral pointColumn)
|
||||
|
||||
assignTerm :: Ptr TS.Language -> Source -> Record DefaultFields -> [ Term S.Syntax (Record DefaultFields) ] -> IO [ Term S.Syntax (Record DefaultFields) ] -> IO (Term S.Syntax (Record DefaultFields))
|
||||
assignTerm language source annotation children allChildren =
|
||||
case assignTermByLanguage source (category annotation) children of
|
||||
Just a -> pure (termIn annotation a)
|
||||
_ -> defaultTermAssignment source annotation children allChildren
|
||||
where assignTermByLanguage :: Source -> Category -> [ Term S.Syntax (Record DefaultFields) ] -> Maybe (S.Syntax (Term S.Syntax (Record DefaultFields)))
|
||||
assignTermByLanguage = case languageForTSLanguage language of
|
||||
Just Language.Go -> Go.termAssignment
|
||||
_ -> \ _ _ _ -> Nothing
|
||||
|
||||
defaultTermAssignment :: Source -> Record DefaultFields -> [ Term S.Syntax (Record DefaultFields) ] -> IO [ Term S.Syntax (Record DefaultFields) ] -> IO (Term S.Syntax (Record DefaultFields))
|
||||
defaultTermAssignment source annotation children allChildren
|
||||
| category annotation `elem` operatorCategories = Term . In annotation . S.Operator <$> allChildren
|
||||
| otherwise = case (category annotation, children) of
|
||||
(ParseError, children) -> toTerm $ S.ParseError children
|
||||
|
||||
(Comment, _) -> toTerm $ S.Comment (toText source)
|
||||
|
||||
(Pair, [key, value]) -> toTerm $ S.Pair key value
|
||||
|
||||
-- Control flow statements
|
||||
(If, condition : body) -> toTerm $ S.If condition body
|
||||
(Switch, _) -> let (subject, body) = break ((== Other "switch_body") . Info.category . termAnnotation) children in toTerm $ S.Switch subject (body >>= toList . termOut)
|
||||
(Case, expr : body) -> toTerm $ S.Case expr body
|
||||
(While, expr : rest) -> toTerm $ S.While expr rest
|
||||
|
||||
-- Statements
|
||||
(Return, _) -> toTerm $ S.Return children
|
||||
(Yield, _) -> toTerm $ S.Yield children
|
||||
(Throw, [expr]) -> toTerm $ S.Throw expr
|
||||
(Break, [label]) -> toTerm $ S.Break (Just label)
|
||||
(Break, []) -> toTerm $ S.Break Nothing
|
||||
(Continue, [label]) -> toTerm $ S.Continue (Just label)
|
||||
(Continue, []) -> toTerm $ S.Continue Nothing
|
||||
|
||||
(ParenthesizedExpression, [child]) -> pure child
|
||||
|
||||
(Other "unary_expression", _) -> do
|
||||
cs <- allChildren
|
||||
let c = case category . termAnnotation <$> cs of
|
||||
[Other s, _]
|
||||
| s `elem` ["-", "+", "++", "--"] -> MathOperator
|
||||
| s == "~" -> BitwiseOperator
|
||||
| s == "!" -> BooleanOperator
|
||||
[_, Other t]
|
||||
| t `elem` ["--", "++"] -> MathOperator
|
||||
_ -> Operator
|
||||
pure (termIn (setCategory annotation c) (S.Operator cs))
|
||||
|
||||
(Other "binary_expression", _) -> do
|
||||
cs <- allChildren
|
||||
let c = case category . termAnnotation <$> cs of
|
||||
[_, Other s, _]
|
||||
| s `elem` ["<=", "<", ">=", ">", "==", "===", "!=", "!=="] -> RelationalOperator
|
||||
| s `elem` ["*", "+", "-", "/", "%"] -> MathOperator
|
||||
| s `elem` ["&&", "||"] -> BooleanOperator
|
||||
| s `elem` [">>", ">>=", ">>>", ">>>=", "<<", "<<=", "&", "^", "|"] -> BitwiseOperator
|
||||
_ -> Operator
|
||||
pure (termIn (setCategory annotation c) (S.Operator cs))
|
||||
|
||||
(_, []) -> toTerm $ S.Leaf (toText source)
|
||||
(_, children) -> toTerm $ S.Indexed children
|
||||
where operatorCategories =
|
||||
[ Operator
|
||||
, Binary
|
||||
, Unary
|
||||
, RangeExpression
|
||||
, ScopeOperator
|
||||
, BooleanOperator
|
||||
, MathOperator
|
||||
, RelationalOperator
|
||||
, BitwiseOperator
|
||||
]
|
||||
toTerm = pure . Term . In annotation
|
||||
|
||||
|
||||
categoryForLanguageProductionName :: Ptr TS.Language -> Text -> Category
|
||||
categoryForLanguageProductionName = withDefaults . byLanguage
|
||||
where
|
||||
withDefaults productionMap name = case name of
|
||||
"ERROR" -> ParseError
|
||||
s -> productionMap s
|
||||
|
||||
byLanguage language = case languageForTSLanguage language of
|
||||
Just Language.Go -> Go.categoryForGoName
|
||||
_ -> Other
|
||||
|
||||
|
||||
languageForTSLanguage :: Ptr TS.Language -> Maybe Language
|
||||
languageForTSLanguage = flip lookup
|
||||
[ (TS.tree_sitter_go, Language.Go)
|
||||
]
|
||||
|
@ -29,8 +29,6 @@ import Rendering.TOC as R
|
||||
-- | Specification of renderers for diffs, producing output in the parameter type.
|
||||
data DiffRenderer output where
|
||||
-- | Compute a table of contents for the diff & encode it as JSON.
|
||||
OldToCDiffRenderer :: DiffRenderer Summaries
|
||||
-- | Compute a table of contents for the diff & encode it as JSON (uses the new Assignment parse tree parser).
|
||||
ToCDiffRenderer :: DiffRenderer Summaries
|
||||
-- | Render to JSON with the format documented in docs/json-format.md
|
||||
JSONDiffRenderer :: DiffRenderer (Map.Map Text Value)
|
||||
|
@ -37,10 +37,10 @@ import Data.Output
|
||||
import Data.Patch
|
||||
import Data.Record
|
||||
import Data.Semigroup ((<>))
|
||||
import Data.Span
|
||||
import Data.Term
|
||||
import qualified Data.Text as T
|
||||
import GHC.Generics
|
||||
import Info
|
||||
|
||||
data Summaries = Summaries { changes, errors :: !(Map.Map T.Text [Value]) }
|
||||
deriving (Eq, Show)
|
||||
@ -152,8 +152,8 @@ entrySummary entry = case entry of
|
||||
-- | Construct a 'TOCSummary' from a node annotation and a change type label.
|
||||
recordSummary :: (HasField fields (Maybe Declaration), HasField fields Span) => T.Text -> Record fields -> Maybe TOCSummary
|
||||
recordSummary changeText record = case getDeclaration record of
|
||||
Just (ErrorDeclaration text _ language) -> Just $ ErrorSummary text (sourceSpan record) language
|
||||
Just declaration -> Just $ TOCSummary (toCategoryName declaration) (formatIdentifier declaration) (sourceSpan record) changeText
|
||||
Just (ErrorDeclaration text _ language) -> Just $ ErrorSummary text (getField record) language
|
||||
Just declaration -> Just $ TOCSummary (toCategoryName declaration) (formatIdentifier declaration) (getField record) changeText
|
||||
Nothing -> Nothing
|
||||
where
|
||||
formatIdentifier (MethodDeclaration identifier _ (Just Language.Go) (Just receiver)) = "(" <> receiver <> ") " <> identifier
|
||||
|
@ -8,9 +8,9 @@ import Data.Aeson
|
||||
import Data.Blob
|
||||
import Data.Maybe (mapMaybe)
|
||||
import Data.Record
|
||||
import Data.Span
|
||||
import Data.Term
|
||||
import GHC.Generics
|
||||
import Info
|
||||
import qualified Data.Text as T
|
||||
import Rendering.TOC
|
||||
|
||||
@ -25,7 +25,7 @@ renderToTags Blob{..} = fmap toJSON . termToC blobPath
|
||||
tagSummary :: (HasField fields (Maybe Declaration), HasField fields Span) => FilePath -> T.Text -> Record fields -> Maybe Tag
|
||||
tagSummary path _ record = case getDeclaration record of
|
||||
Just ErrorDeclaration{} -> Nothing
|
||||
Just declaration -> Just $ Tag (declarationIdentifier declaration) (T.pack path) (T.pack . show <$> declarationLanguage declaration) (toCategoryName declaration) (declarationText declaration) (sourceSpan record)
|
||||
Just declaration -> Just $ Tag (declarationIdentifier declaration) (T.pack path) (T.pack . show <$> declarationLanguage declaration) (toCategoryName declaration) (declarationText declaration) (getField record)
|
||||
_ -> Nothing
|
||||
|
||||
data Tag
|
||||
|
@ -9,10 +9,9 @@ module Semantic
|
||||
|
||||
import Analysis.ConstructorName (ConstructorName, constructorLabel)
|
||||
import Analysis.IdentifierName (IdentifierName, identifierLabel)
|
||||
import Analysis.Declaration (HasDeclaration, declarationAlgebra, syntaxDeclarationAlgebra)
|
||||
import Analysis.Decorator (syntaxIdentifierAlgebra)
|
||||
import Analysis.Declaration (HasDeclaration, declarationAlgebra)
|
||||
import Control.Exception
|
||||
import Control.Monad ((>=>), guard)
|
||||
import Control.Monad ((>=>))
|
||||
import Control.Monad.Error.Class
|
||||
import Data.Align.Generic
|
||||
import Data.Bifoldable
|
||||
@ -22,14 +21,12 @@ import Data.ByteString (ByteString)
|
||||
import Data.Diff
|
||||
import Data.Functor.Classes
|
||||
import Data.JSON.Fields
|
||||
import qualified Data.Language as Language
|
||||
import Data.Output
|
||||
import Data.Record
|
||||
import Data.Term
|
||||
import Data.Typeable
|
||||
import Diffing.Algorithm (Diffable)
|
||||
import Diffing.Interpreter
|
||||
import Info
|
||||
import Parsing.Parser
|
||||
import Rendering.Renderer
|
||||
import Semantic.Stat as Stat
|
||||
@ -50,25 +47,16 @@ parseBlobs renderer = fmap toOutput . distributeFoldMap (parseBlob renderer)
|
||||
-- | A task to parse a 'Blob' and render the resulting 'Term'.
|
||||
parseBlob :: TermRenderer output -> Blob -> Task output
|
||||
parseBlob renderer blob@Blob{..}
|
||||
| Just (SomeParser parser) <- blobLanguage >>= someParser (Proxy :: Proxy '[ConstructorName, IdentifierName, HasDeclaration, Foldable, Functor, ToJSONFields1])
|
||||
| Just (SomeParser parser) <- someParser (Proxy :: Proxy '[ConstructorName, HasDeclaration, IdentifierName, Foldable, Functor, ToJSONFields1]) <$> blobLanguage
|
||||
= parse parser blob >>= case renderer of
|
||||
ToCTermRenderer -> decorate (declarationAlgebra blob) >=> render (renderToCTerm blob)
|
||||
ToCTermRenderer -> decorate (declarationAlgebra blob) >=> render (renderToCTerm blob)
|
||||
JSONTermRenderer -> decorate constructorLabel >=> decorate identifierLabel >=> render (renderJSONTerm blob)
|
||||
SExpressionTermRenderer -> decorate constructorLabel . (Nil <$) >=> render renderSExpressionTerm
|
||||
TagsTermRenderer -> decorate (declarationAlgebra blob) >=> render (renderToTags blob)
|
||||
SExpressionTermRenderer -> decorate constructorLabel . (Nil <$) >=> render renderSExpressionTerm
|
||||
TagsTermRenderer -> decorate (declarationAlgebra blob) >=> render (renderToTags blob)
|
||||
DOTTermRenderer -> render (renderDOTTerm blob)
|
||||
| otherwise = throwError (SomeException (NoLanguageForBlob blobPath))
|
||||
|
||||
| Just parser <- blobLanguage >>= syntaxParserForLanguage
|
||||
= parse parser blob >>= case renderer of
|
||||
ToCTermRenderer -> decorate (syntaxDeclarationAlgebra blob) >=> render (renderToCTerm blob)
|
||||
JSONTermRenderer -> decorate syntaxIdentifierAlgebra >=> render (renderJSONTerm blob)
|
||||
SExpressionTermRenderer -> render renderSExpressionTerm . fmap keepCategory
|
||||
TagsTermRenderer -> decorate (syntaxDeclarationAlgebra blob) >=> render (renderToTags blob)
|
||||
DOTTermRenderer -> render (renderDOTTerm blob)
|
||||
|
||||
| otherwise = throwError (SomeException (NoParserForLanguage blobPath blobLanguage))
|
||||
|
||||
data NoParserForLanguage = NoParserForLanguage FilePath (Maybe Language.Language)
|
||||
data NoLanguageForBlob = NoLanguageForBlob FilePath
|
||||
deriving (Eq, Exception, Ord, Show, Typeable)
|
||||
|
||||
|
||||
@ -78,39 +66,17 @@ diffBlobPairs renderer = fmap toOutput . distributeFoldMap (diffBlobPair rendere
|
||||
-- | A task to parse a pair of 'Blob's, diff them, and render the 'Diff'.
|
||||
diffBlobPair :: DiffRenderer output -> BlobPair -> Task output
|
||||
diffBlobPair renderer blobs
|
||||
| Just (SomeParser parser) <- effectiveLanguage >>= qualify >>= someParser (Proxy :: Proxy '[ConstructorName, IdentifierName, Diffable, Eq1, GAlign, HasDeclaration, Show1, ToJSONFields1, Traversable])
|
||||
| Just (SomeParser parser) <- someParser (Proxy :: Proxy '[ConstructorName, Diffable, Eq1, GAlign, HasDeclaration, IdentifierName, Show1, ToJSONFields1, Traversable]) <$> effectiveLanguage
|
||||
= case renderer of
|
||||
OldToCDiffRenderer -> run (\ blob -> parse parser blob >>= decorate (declarationAlgebra blob)) diffTerms renderToCDiff
|
||||
ToCDiffRenderer -> run (\ blob -> parse parser blob >>= decorate (declarationAlgebra blob)) diffTerms renderToCDiff
|
||||
ToCDiffRenderer -> run (\ blob -> parse parser blob >>= decorate (declarationAlgebra blob)) diffTerms renderToCDiff
|
||||
JSONDiffRenderer -> run ( parse parser >=> decorate constructorLabel >=> decorate identifierLabel) diffTerms renderJSONDiff
|
||||
SExpressionDiffRenderer -> run ( parse parser >=> decorate constructorLabel . (Nil <$)) diffTerms (const renderSExpressionDiff)
|
||||
DOTDiffRenderer -> run ( parse parser) diffTerms renderDOTDiff
|
||||
SExpressionDiffRenderer -> run ( parse parser >=> decorate constructorLabel . (Nil <$)) diffTerms (const renderSExpressionDiff)
|
||||
DOTDiffRenderer -> run ( parse parser) diffTerms renderDOTDiff
|
||||
| otherwise = throwError (SomeException (NoLanguageForBlob effectivePath))
|
||||
where effectivePath = pathForBlobPair blobs
|
||||
effectiveLanguage = languageForBlobPair blobs
|
||||
|
||||
| Just parser <- effectiveLanguage >>= syntaxParserForLanguage
|
||||
= case renderer of
|
||||
OldToCDiffRenderer -> run (\ blob -> parse parser blob >>= decorate (syntaxDeclarationAlgebra blob)) diffSyntaxTerms renderToCDiff
|
||||
ToCDiffRenderer -> run (\ blob -> parse parser blob >>= decorate (syntaxDeclarationAlgebra blob)) diffSyntaxTerms renderToCDiff
|
||||
JSONDiffRenderer -> run ( parse parser >=> decorate syntaxIdentifierAlgebra) diffSyntaxTerms renderJSONDiff
|
||||
SExpressionDiffRenderer -> run ( parse parser >=> pure . fmap keepCategory) diffSyntaxTerms (const renderSExpressionDiff)
|
||||
DOTDiffRenderer -> run ( parse parser) diffSyntaxTerms renderDOTDiff
|
||||
|
||||
| otherwise = throwError (SomeException (NoParserForLanguage effectivePath effectiveLanguage))
|
||||
where effectiveLanguage = languageForBlobPair blobs
|
||||
effectivePath = pathForBlobPair blobs
|
||||
|
||||
qualify language | OldToCDiffRenderer <- renderer = guard (language `elem` aLaCarteLanguages) *> Just language
|
||||
| otherwise = Just language
|
||||
aLaCarteLanguages
|
||||
= [ Language.Go
|
||||
, Language.JSX
|
||||
, Language.JavaScript
|
||||
, Language.Markdown
|
||||
, Language.Python
|
||||
, Language.Ruby
|
||||
, Language.TypeScript
|
||||
]
|
||||
|
||||
run :: (Foldable syntax, Functor syntax) => (Blob -> Task (Term syntax ann)) -> (Term syntax ann -> Term syntax ann -> Diff syntax ann ann) -> (Join These Blob -> Diff syntax ann ann -> output) -> Task output
|
||||
run :: (Foldable syntax, Functor syntax) => (Blob -> Task (Term syntax ann)) -> (Term syntax ann -> Term syntax ann -> Diff syntax ann ann) -> (BlobPair -> Diff syntax ann ann -> output) -> Task output
|
||||
run parse diff renderer = do
|
||||
terms <- bidistributeFor (runJoin blobs) parse parse
|
||||
time "diff" languageTag $ do
|
||||
@ -125,6 +91,3 @@ diffTermPair :: Functor syntax => Differ syntax ann1 ann2 -> These (Term syntax
|
||||
diffTermPair _ (This t1 ) = pure (deleting t1)
|
||||
diffTermPair _ (That t2) = pure (inserting t2)
|
||||
diffTermPair differ (These t1 t2) = diff differ t1 t2
|
||||
|
||||
keepCategory :: HasField fields Category => Record fields -> Record '[Category]
|
||||
keepCategory = (:. Nil) . category
|
||||
|
@ -64,7 +64,7 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar
|
||||
diffArgumentsParser = runDiff
|
||||
<$> ( flag (SomeRenderer SExpressionDiffRenderer) (SomeRenderer SExpressionDiffRenderer) (long "sexpression" <> help "Output s-expression diff tree")
|
||||
<|> flag' (SomeRenderer JSONDiffRenderer) (long "json" <> help "Output JSON diff trees")
|
||||
<|> flag' (SomeRenderer OldToCDiffRenderer) (long "toc" <> help "Output JSON table of contents diff summary")
|
||||
<|> flag' (SomeRenderer ToCDiffRenderer) (long "toc" <> help "Output JSON table of contents diff summary")
|
||||
<|> flag' (SomeRenderer ToCDiffRenderer) (long "toc-assignment" <> help "Output JSON table of contents diff summary using the assignment parser")
|
||||
<|> flag' (SomeRenderer DOTDiffRenderer) (long "dot" <> help "Output the diff as a DOT graph"))
|
||||
<*> ( Right <$> some (both
|
||||
|
@ -51,7 +51,6 @@ import Data.Record
|
||||
import qualified Data.Syntax as Syntax
|
||||
import Data.Term
|
||||
import Data.Union
|
||||
import Info hiding (Category(..))
|
||||
import Parsing.Parser
|
||||
import Parsing.CMark
|
||||
import Parsing.TreeSitter
|
||||
@ -248,9 +247,6 @@ runParser Options{..} blob@Blob{..} = go
|
||||
writeLog Warning (Error.formatError optionsPrintSource (optionsIsTerminal && optionsEnableColour) blob err) (("task", "assign") : blobFields)
|
||||
writeStat (Stat.count "parse.nodes" (length term) languageTag)
|
||||
pure term
|
||||
TreeSitterParser tslanguage ->
|
||||
time "parse.tree_sitter_parse" languageTag $
|
||||
liftIO (treeSitterParser tslanguage blob)
|
||||
MarkdownParser ->
|
||||
time "parse.cmark_parse" languageTag $
|
||||
let term = cmarkParser blobSource
|
||||
@ -259,7 +255,7 @@ runParser Options{..} blob@Blob{..} = go
|
||||
languageTag = maybe [] (pure . (,) ("language" :: String) . show) blobLanguage
|
||||
errors :: (Syntax.Error :< fs, Apply Foldable fs, Apply Functor fs) => Term (Union fs) (Record Assignment.Location) -> [Error.Error String]
|
||||
errors = cata $ \ (In a syntax) -> case syntax of
|
||||
_ | Just err@Syntax.Error{} <- prj syntax -> [Syntax.unError (sourceSpan a) err]
|
||||
_ | Just err@Syntax.Error{} <- prj syntax -> [Syntax.unError (getField a) err]
|
||||
_ -> fold syntax
|
||||
|
||||
instance MonadIO Task where
|
||||
|
165
src/Syntax.hs
165
src/Syntax.hs
@ -1,165 +0,0 @@
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
module Syntax where
|
||||
|
||||
import Diffing.Algorithm
|
||||
import Data.Aeson (ToJSON, (.=))
|
||||
import Data.Align.Generic
|
||||
import Data.Foldable (toList)
|
||||
import Data.Functor.Classes.Generic
|
||||
import Data.JSON.Fields
|
||||
import Data.Mergeable
|
||||
import Data.Text (Text)
|
||||
import GHC.Generics
|
||||
|
||||
-- | A node in an abstract syntax tree.
|
||||
--
|
||||
-- 'f' is the type representing another level of the tree, e.g. the children of branches. Often 'Cofree', 'Free' or similar.
|
||||
data Syntax f
|
||||
-- | A terminal syntax node, e.g. an identifier, or atomic literal.
|
||||
= Leaf Text
|
||||
-- | An ordered branch of child nodes, expected to be variadic in the grammar, e.g. a list of statements or uncurried function parameters.
|
||||
| Indexed [f]
|
||||
-- | An ordered branch of child nodes, expected to be of fixed length in the grammar, e.g. a binary operator & its operands.
|
||||
| Fixed [f]
|
||||
-- | A function call has an identifier where f is a (Leaf a) and a list of arguments.
|
||||
| FunctionCall f [f] [f]
|
||||
-- | A ternary has a condition, a true case and a false case
|
||||
| Ternary f [f]
|
||||
-- | An anonymous function has a list of expressions and params.
|
||||
| AnonymousFunction [f] [f]
|
||||
-- | A function has an identifier, possible type arguments, params, a possible type, and list of expressions.
|
||||
| Function f [f] [f]
|
||||
-- | An assignment has an identifier where f can be a member access, and the value is another syntax element (function call, leaf, etc.)
|
||||
| Assignment f f
|
||||
-- | An operator assignment represents expressions with operators like math (e.g x += 1) or conditional (e.g. x ||= 1) assignment.
|
||||
| OperatorAssignment f f
|
||||
-- | A member access contains a syntax, and another syntax that identifies a property or value in the first syntax.
|
||||
-- | e.g. in Javascript x.y represents a member access syntax.
|
||||
| MemberAccess f f
|
||||
-- | A method call consisting of its target, the method name, and the parameters passed to the method.
|
||||
-- | e.g. in Javascript console.log('hello') represents a method call.
|
||||
| MethodCall f f [f] [f]
|
||||
-- | An operator can be applied to a list of syntaxes.
|
||||
| Operator [f]
|
||||
-- | A variable declaration. e.g. var foo;
|
||||
| VarDecl [f]
|
||||
-- | A variable assignment in a variable declaration. var foo = bar;
|
||||
| VarAssignment [f] f
|
||||
-- | A subscript access contains a syntax, and another syntax that indefies a property or value in the first syntax.
|
||||
-- | e.g. in Javascript x["y"] represents a subscript access syntax.
|
||||
| SubscriptAccess f f
|
||||
| Switch [f] [f]
|
||||
| Case f [f]
|
||||
-- | A default case in a switch statement.
|
||||
| DefaultCase [f]
|
||||
| Select [f]
|
||||
| Object (Maybe f) [f]
|
||||
-- | A pair in an Object. e.g. foo: bar or foo => bar
|
||||
| Pair f f
|
||||
-- | A comment.
|
||||
| Comment Text
|
||||
-- | A term preceded or followed by any number of comments.
|
||||
| Commented [f] (Maybe f)
|
||||
| ParseError [f]
|
||||
-- | A for statement has a list of expressions to setup the iteration and then a list of expressions in the body.
|
||||
| For [f] [f]
|
||||
| DoWhile f f
|
||||
| While f [f]
|
||||
| Return [f]
|
||||
| Throw f
|
||||
| Constructor f
|
||||
-- | TODO: Is it a problem that in Ruby, this pattern can work for method def too?
|
||||
| Try [f] [f] (Maybe f) (Maybe f)
|
||||
-- | An array literal with list of children.
|
||||
| Array (Maybe f) [f]
|
||||
-- | A class with an identifier, superclass, and a list of definitions.
|
||||
| Class f [f] [f]
|
||||
-- | A method definition with an identifier, optional receiver, optional type arguments, params, optional return type, and a list of expressions.
|
||||
| Method [f] f (Maybe f) [f] [f]
|
||||
-- | An if statement with an expression and maybe more expression clauses.
|
||||
| If f [f]
|
||||
-- | A module with an identifier, and a list of syntaxes.
|
||||
| Module f [f]
|
||||
-- | An interface with an identifier, a list of clauses, and a list of declarations..
|
||||
| Interface f [f] [f]
|
||||
| Namespace f [f]
|
||||
| Import f [f]
|
||||
| Export (Maybe f) [f]
|
||||
| Yield [f]
|
||||
-- | A negation of a single expression.
|
||||
| Negate f
|
||||
-- | A rescue block has a list of arguments to rescue and a list of expressions.
|
||||
| Rescue [f] [f]
|
||||
| Go f
|
||||
| Defer f
|
||||
| TypeAssertion f f
|
||||
| TypeConversion f f
|
||||
-- | A struct with an optional type.
|
||||
| Struct (Maybe f) [f]
|
||||
| Break (Maybe f)
|
||||
| Continue (Maybe f)
|
||||
-- | A block statement has an ordered branch of child nodes, e.g. BEGIN {...} or END {...} in Ruby/Perl.
|
||||
| BlockStatement [f]
|
||||
-- | A parameter declaration with an optional type.
|
||||
| ParameterDecl (Maybe f) f
|
||||
-- | A type declaration has an identifier and a type.
|
||||
| TypeDecl f f
|
||||
-- | A field declaration with an optional type, and an optional tag.
|
||||
| FieldDecl [f]
|
||||
-- | A type.
|
||||
| Ty [f]
|
||||
-- | A send statement has a channel and an expression in Go.
|
||||
| Send f f
|
||||
deriving (Eq, Foldable, Functor, GAlign, Generic, Generic1, Mergeable, Ord, Show, Traversable, ToJSON)
|
||||
|
||||
|
||||
extractLeafValue :: Syntax a -> Maybe Text
|
||||
extractLeafValue syntax = case syntax of
|
||||
Leaf a -> Just a
|
||||
_ -> Nothing
|
||||
|
||||
-- Instances
|
||||
|
||||
instance Eq1 Syntax where liftEq = genericLiftEq
|
||||
instance Show1 Syntax where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
instance ToJSONFields1 Syntax where
|
||||
toJSONFields1 syntax = [ "children" .= toList syntax ]
|
||||
|
||||
instance Diffable Syntax where
|
||||
algorithmFor s1 s2 = case (s1, s2) of
|
||||
(Indexed a, Indexed b) ->
|
||||
Indexed <$> byRWS a b
|
||||
(Module idA a, Module idB b) ->
|
||||
Module <$> diff idA idB <*> byRWS a b
|
||||
(FunctionCall identifierA typeParamsA argsA, FunctionCall identifierB typeParamsB argsB) ->
|
||||
FunctionCall <$> diff identifierA identifierB
|
||||
<*> byRWS typeParamsA typeParamsB
|
||||
<*> byRWS argsA argsB
|
||||
(Switch exprA casesA, Switch exprB casesB) ->
|
||||
Switch <$> byRWS exprA exprB
|
||||
<*> byRWS casesA casesB
|
||||
(Object tyA a, Object tyB b) ->
|
||||
Object <$> diffMaybe tyA tyB
|
||||
<*> byRWS a b
|
||||
(Commented commentsA a, Commented commentsB b) ->
|
||||
Commented <$> byRWS commentsA commentsB
|
||||
<*> diffMaybe a b
|
||||
(Array tyA a, Array tyB b) ->
|
||||
Array <$> diffMaybe tyA tyB
|
||||
<*> byRWS a b
|
||||
(Class identifierA clausesA expressionsA, Class identifierB clausesB expressionsB) ->
|
||||
Class <$> diff identifierA identifierB
|
||||
<*> byRWS clausesA clausesB
|
||||
<*> byRWS expressionsA expressionsB
|
||||
(Method clausesA identifierA receiverA paramsA expressionsA, Method clausesB identifierB receiverB paramsB expressionsB) ->
|
||||
Method <$> byRWS clausesA clausesB
|
||||
<*> diff identifierA identifierB
|
||||
<*> diffMaybe receiverA receiverB
|
||||
<*> byRWS paramsA paramsB
|
||||
<*> byRWS expressionsA expressionsB
|
||||
(Function idA paramsA bodyA, Function idB paramsB bodyB) ->
|
||||
Function <$> diff idA idB
|
||||
<*> byRWS paramsA paramsB
|
||||
<*> byRWS bodyA bodyB
|
||||
_ -> galignWith diffThese s1 s2
|
@ -29,7 +29,6 @@ module Data.Functor.Listable
|
||||
|
||||
import Analysis.CyclomaticComplexity
|
||||
import Analysis.Declaration
|
||||
import qualified Category
|
||||
import Control.Monad.Free as Free
|
||||
import Control.Monad.Trans.Free as FreeF
|
||||
import Data.ByteString (ByteString)
|
||||
@ -54,7 +53,6 @@ import qualified Data.Text.Encoding as T
|
||||
import Data.These
|
||||
import Data.Union
|
||||
import Diffing.Algorithm.RWS
|
||||
import Syntax as S
|
||||
import Test.LeanCheck
|
||||
|
||||
type Tier a = [a]
|
||||
@ -206,27 +204,6 @@ instance Listable (Record '[]) where
|
||||
tiers = cons0 Nil
|
||||
|
||||
|
||||
instance Listable Category.Category where
|
||||
tiers = cons0 Category.Program
|
||||
\/ cons0 Category.ParseError
|
||||
\/ cons0 Category.Boolean
|
||||
\/ cons0 Category.BooleanOperator
|
||||
\/ cons0 Category.FunctionCall
|
||||
\/ cons0 Category.Function
|
||||
\/ cons0 Category.Identifier
|
||||
\/ cons0 Category.MethodCall
|
||||
\/ cons0 Category.StringLiteral
|
||||
\/ cons0 Category.IntegerLiteral
|
||||
\/ cons0 Category.NumberLiteral
|
||||
\/ cons0 Category.Return
|
||||
\/ cons0 Category.If
|
||||
\/ cons0 Category.Class
|
||||
\/ cons0 Category.Method
|
||||
\/ cons0 Category.Binary
|
||||
\/ cons0 Category.Unary
|
||||
\/ cons0 Category.SingletonMethod
|
||||
|
||||
|
||||
instance Listable2 Patch where
|
||||
liftTiers2 t1 t2 = liftCons1 t2 Insert \/ liftCons1 t1 Delete \/ liftCons2 t1 t2 Replace
|
||||
|
||||
@ -234,67 +211,6 @@ instance (Listable a, Listable b) => Listable (Patch a b) where
|
||||
tiers = tiers2
|
||||
|
||||
|
||||
instance Listable1 Syntax where
|
||||
liftTiers recur
|
||||
= liftCons1 (pack `mapT` tiers) Leaf
|
||||
\/ liftCons1 (liftTiers recur) Indexed
|
||||
\/ liftCons1 (liftTiers recur) Fixed
|
||||
\/ liftCons3 recur (liftTiers recur) (liftTiers recur) FunctionCall
|
||||
\/ liftCons2 recur (liftTiers recur) Ternary
|
||||
\/ liftCons2 (liftTiers recur) (liftTiers recur) AnonymousFunction
|
||||
\/ liftCons3 recur (liftTiers recur) (liftTiers recur) Function
|
||||
\/ liftCons2 recur recur Assignment
|
||||
\/ liftCons2 recur recur OperatorAssignment
|
||||
\/ liftCons2 recur recur MemberAccess
|
||||
\/ liftCons4 recur recur (liftTiers recur) (liftTiers recur) MethodCall
|
||||
\/ liftCons1 (liftTiers recur) Operator
|
||||
\/ liftCons1 (liftTiers recur) VarDecl
|
||||
\/ liftCons2 (liftTiers recur) recur VarAssignment
|
||||
\/ liftCons2 recur recur SubscriptAccess
|
||||
\/ liftCons2 (liftTiers recur) (liftTiers recur) Switch
|
||||
\/ liftCons2 recur (liftTiers recur) Case
|
||||
\/ liftCons1 (liftTiers recur) Select
|
||||
\/ liftCons2 (liftTiers recur) (liftTiers recur) S.Object
|
||||
\/ liftCons2 recur recur S.Pair
|
||||
\/ liftCons1 (pack `mapT` tiers) Comment
|
||||
\/ liftCons2 (liftTiers recur) (liftTiers recur) Commented
|
||||
\/ liftCons1 (liftTiers recur) S.ParseError
|
||||
\/ liftCons2 (liftTiers recur) (liftTiers recur) For
|
||||
\/ liftCons2 recur recur DoWhile
|
||||
\/ liftCons2 recur (liftTiers recur) While
|
||||
\/ liftCons1 (liftTiers recur) Return
|
||||
\/ liftCons1 recur Throw
|
||||
\/ liftCons1 recur Constructor
|
||||
\/ liftCons4 (liftTiers recur) (liftTiers recur) (liftTiers recur) (liftTiers recur) Try
|
||||
\/ liftCons2 (liftTiers recur) (liftTiers recur) S.Array
|
||||
\/ liftCons3 recur (liftTiers recur) (liftTiers recur) Class
|
||||
\/ liftCons5 (liftTiers recur) recur (liftTiers recur) (liftTiers recur) (liftTiers recur) Method
|
||||
\/ liftCons2 recur (liftTiers recur) If
|
||||
\/ liftCons2 recur (liftTiers recur) Module
|
||||
\/ liftCons2 recur (liftTiers recur) Namespace
|
||||
\/ liftCons2 recur (liftTiers recur) Import
|
||||
\/ liftCons2 (liftTiers recur) (liftTiers recur) Export
|
||||
\/ liftCons1 (liftTiers recur) Yield
|
||||
\/ liftCons1 recur Negate
|
||||
\/ liftCons2 (liftTiers recur) (liftTiers recur) Rescue
|
||||
\/ liftCons1 recur Go
|
||||
\/ liftCons1 recur Defer
|
||||
\/ liftCons2 recur recur TypeAssertion
|
||||
\/ liftCons2 recur recur TypeConversion
|
||||
\/ liftCons1 (liftTiers recur) Break
|
||||
\/ liftCons1 (liftTiers recur) Continue
|
||||
\/ liftCons1 (liftTiers recur) BlockStatement
|
||||
\/ liftCons2 (liftTiers recur) recur ParameterDecl
|
||||
\/ liftCons2 recur recur TypeDecl
|
||||
\/ liftCons1 (liftTiers recur) FieldDecl
|
||||
\/ liftCons1 (liftTiers recur) Ty
|
||||
\/ liftCons2 recur recur Send
|
||||
\/ liftCons1 (liftTiers recur) DefaultCase
|
||||
|
||||
instance Listable recur => Listable (Syntax recur) where
|
||||
tiers = tiers1
|
||||
|
||||
|
||||
instance (Listable1 f, Listable1 (Union (g ': fs))) => Listable1 (Union (f ': g ': fs)) where
|
||||
liftTiers tiers = (inj `mapT` ((liftTiers :: [Tier a] -> [Tier (f a)]) tiers)) \/ (weaken `mapT` ((liftTiers :: [Tier a] -> [Tier (Union (g ': fs) a)]) tiers))
|
||||
|
||||
|
@ -6,8 +6,6 @@ import Data.Functor.Identity
|
||||
import Data.Functor.Listable
|
||||
import Data.Maybe (catMaybes)
|
||||
import Data.Mergeable
|
||||
import Data.Syntax
|
||||
import Syntax
|
||||
import Test.Hspec
|
||||
import Test.Hspec.LeanCheck
|
||||
import Test.LeanCheck
|
||||
@ -23,12 +21,9 @@ spec = parallel $ do
|
||||
describe "Identity" $ do
|
||||
withAlternativeInstances sequenceAltLaws (Identity `mapT` tiers :: [Tier (Identity Char)])
|
||||
withAlternativeInstances mergeLaws (Identity `mapT` tiers :: [Tier (Identity Char)])
|
||||
describe "Union" $ do
|
||||
describe "ListableSyntax" $ do
|
||||
withAlternativeInstances sequenceAltLaws (tiers :: [Tier (ListableSyntax Char)])
|
||||
withAlternativeInstances mergeLaws (tiers :: [Tier (ListableSyntax Char)])
|
||||
describe "Syntax" $ do
|
||||
withAlternativeInstances sequenceAltLaws (tiers :: [Tier (Syntax Char)])
|
||||
withAlternativeInstances mergeLaws (tiers :: [Tier (Syntax Char)])
|
||||
|
||||
prop "subsumes catMaybes/Just" $
|
||||
\ a -> sequenceAlt a `shouldBe` pure (catMaybes (a :: [Maybe Char]))
|
||||
|
@ -1,11 +1,8 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
module Data.Term.Spec where
|
||||
|
||||
import Category
|
||||
import Data.Functor.Listable
|
||||
import Data.Record
|
||||
import Data.Term
|
||||
import Syntax
|
||||
import Test.Hspec (Spec, describe, parallel)
|
||||
import Test.Hspec.Expectations.Pretty
|
||||
import Test.Hspec.LeanCheck
|
||||
@ -14,4 +11,4 @@ spec :: Spec
|
||||
spec = parallel $ do
|
||||
describe "Term" $ do
|
||||
prop "equality is reflexive" $
|
||||
\ a -> unListableF a `shouldBe` (unListableF a :: Term Syntax (Record '[Category]))
|
||||
\ a -> a `shouldBe` (a :: Term ListableSyntax ())
|
||||
|
@ -1,9 +1,8 @@
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
{-# LANGUAGE DataKinds, TypeOperators #-}
|
||||
module Rendering.TOC.Spec where
|
||||
|
||||
import Analysis.Decorator (constructorNameAndConstantFields)
|
||||
import Analysis.Declaration
|
||||
import Category as C hiding (Go)
|
||||
import Data.Aeson
|
||||
import Data.Bifunctor
|
||||
import Data.Blob
|
||||
@ -12,21 +11,24 @@ import Data.Diff
|
||||
import Data.Functor.Both
|
||||
import Data.Functor.Foldable (cata)
|
||||
import Data.Functor.Listable
|
||||
import Data.Functor.Foldable (cata)
|
||||
import Data.Language
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Maybe (fromMaybe, isJust)
|
||||
import Data.Monoid (Last(..))
|
||||
import Data.Output
|
||||
import Data.Patch
|
||||
import Data.Range
|
||||
import Data.Record
|
||||
import Data.Semigroup ((<>))
|
||||
import Data.Source
|
||||
import Data.Span
|
||||
import qualified Data.Syntax as Syntax
|
||||
import qualified Data.Syntax.Declaration as Declaration
|
||||
import Data.Term
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Data.These
|
||||
import Diffing.Algorithm.RWS
|
||||
import Data.Union
|
||||
import Diffing.Interpreter
|
||||
import Info hiding (Go)
|
||||
import Parsing.Parser
|
||||
import Prelude hiding (readFile)
|
||||
import Rendering.Renderer
|
||||
@ -35,8 +37,7 @@ import Semantic
|
||||
import Semantic.Task
|
||||
import Semantic.Util
|
||||
import SpecHelpers
|
||||
import Syntax as S hiding (Go)
|
||||
import Test.Hspec (Spec, describe, it, parallel, pending)
|
||||
import Test.Hspec (Spec, describe, it, parallel)
|
||||
import Test.Hspec.Expectations.Pretty
|
||||
import Test.Hspec.LeanCheck
|
||||
import Test.LeanCheck
|
||||
@ -45,18 +46,18 @@ spec :: Spec
|
||||
spec = parallel $ do
|
||||
describe "tableOfContentsBy" $ do
|
||||
prop "drops all nodes with the constant Nothing function" $
|
||||
\ diff -> tableOfContentsBy (const Nothing :: a -> Maybe ()) (diff :: Diff Syntax () ()) `shouldBe` []
|
||||
\ diff -> tableOfContentsBy (const Nothing :: a -> Maybe ()) (diff :: Diff ListableSyntax () ()) `shouldBe` []
|
||||
|
||||
prop "produces no entries for identity diffs" $
|
||||
\ term -> tableOfContentsBy (Just . termFAnnotation) (diffSyntaxTerms term (term :: Term Syntax (Record '[Category]))) `shouldBe` []
|
||||
\ term -> tableOfContentsBy (Just . termFAnnotation) (diffTerms term (term :: Term ListableSyntax (Record '[Range, Span]))) `shouldBe` []
|
||||
|
||||
prop "produces inserted/deleted/replaced entries for relevant nodes within patches" $
|
||||
\ p -> tableOfContentsBy (Just . termFAnnotation) (patch deleting inserting replacing p)
|
||||
`shouldBe`
|
||||
patch (fmap Deleted) (fmap Inserted) (const (fmap Replaced)) (bimap (foldMap pure) (foldMap pure) (p :: Patch (Term Syntax Int) (Term Syntax Int)))
|
||||
patch (fmap Deleted) (fmap Inserted) (\ as bs -> Replaced (head bs) : fmap Deleted (tail as) <> fmap Inserted (tail bs)) (bimap (foldMap pure) (foldMap pure) (p :: Patch (Term ListableSyntax Int) (Term ListableSyntax Int)))
|
||||
|
||||
prop "produces changed entries for relevant nodes containing irrelevant patches" $
|
||||
\ diff -> let diff' = merge (0, 0) (Indexed [bimap (const 1) (const 1) (diff :: Diff Syntax Int Int)]) in
|
||||
\ diff -> let diff' = merge (0, 0) (inj [bimap (const 1) (const 1) (diff :: Diff ListableSyntax Int Int)]) in
|
||||
tableOfContentsBy (\ (n `In` _) -> if n == (0 :: Int) then Just n else Nothing) diff' `shouldBe`
|
||||
replicate (length (diffPatches diff')) (Changed 0)
|
||||
|
||||
@ -68,71 +69,71 @@ spec = parallel $ do
|
||||
sourceBlobs <- blobsForPaths (both "ruby/methods.A.rb" "ruby/methods.B.rb")
|
||||
diff <- runTask $ diffWithParser rubyParser sourceBlobs
|
||||
diffTOC diff `shouldBe`
|
||||
[ TOCSummary "Method" "self.foo" (sourceSpanBetween (1, 1) (2, 4)) "added"
|
||||
, TOCSummary "Method" "bar" (sourceSpanBetween (4, 1) (6, 4)) "modified"
|
||||
, TOCSummary "Method" "baz" (sourceSpanBetween (4, 1) (5, 4)) "removed"
|
||||
[ TOCSummary "Method" "self.foo" (Span (Pos 1 1) (Pos 2 4)) "added"
|
||||
, TOCSummary "Method" "bar" (Span (Pos 4 1) (Pos 6 4)) "modified"
|
||||
, TOCSummary "Method" "baz" (Span (Pos 4 1) (Pos 5 4)) "removed"
|
||||
]
|
||||
|
||||
it "summarizes changed classes" $ do
|
||||
sourceBlobs <- blobsForPaths (both "ruby/classes.A.rb" "ruby/classes.B.rb")
|
||||
diff <- runTask $ diffWithParser rubyParser sourceBlobs
|
||||
diffTOC diff `shouldBe`
|
||||
[ TOCSummary "Class" "Baz" (sourceSpanBetween (1, 1) (2, 4)) "removed"
|
||||
, TOCSummary "Class" "Foo" (sourceSpanBetween (1, 1) (3, 4)) "modified"
|
||||
, TOCSummary "Class" "Bar" (sourceSpanBetween (5, 1) (6, 4)) "added"
|
||||
[ TOCSummary "Class" "Baz" (Span (Pos 1 1) (Pos 2 4)) "removed"
|
||||
, TOCSummary "Class" "Foo" (Span (Pos 1 1) (Pos 3 4)) "modified"
|
||||
, TOCSummary "Class" "Bar" (Span (Pos 5 1) (Pos 6 4)) "added"
|
||||
]
|
||||
|
||||
it "dedupes changes in same parent method" $ do
|
||||
sourceBlobs <- blobsForPaths (both "javascript/duplicate-parent.A.js" "javascript/duplicate-parent.B.js")
|
||||
diff <- runTask $ diffWithParser typescriptParser sourceBlobs
|
||||
diffTOC diff `shouldBe`
|
||||
[ TOCSummary "Function" "myFunction" (sourceSpanBetween (1, 1) (6, 2)) "modified" ]
|
||||
[ TOCSummary "Function" "myFunction" (Span (Pos 1 1) (Pos 6 2)) "modified" ]
|
||||
|
||||
it "dedupes similar methods" $ do
|
||||
sourceBlobs <- blobsForPaths (both "javascript/erroneous-duplicate-method.A.js" "javascript/erroneous-duplicate-method.B.js")
|
||||
diff <- runTask $ diffWithParser typescriptParser sourceBlobs
|
||||
diffTOC diff `shouldBe`
|
||||
[ TOCSummary "Function" "performHealthCheck" (sourceSpanBetween (8, 1) (29, 2)) "modified" ]
|
||||
[ TOCSummary "Function" "performHealthCheck" (Span (Pos 8 1) (Pos 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")
|
||||
diff <- runTask $ diffWithParser goParser sourceBlobs
|
||||
diffTOC diff `shouldBe`
|
||||
[ TOCSummary "Method" "(*apiClient) CheckAuth" (sourceSpanBetween (3,1) (3,101)) "added" ]
|
||||
[ TOCSummary "Method" "(*apiClient) CheckAuth" (Span (Pos 3 1) (Pos 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")
|
||||
diff <- runTask $ diffWithParser rubyParser sourceBlobs
|
||||
diffTOC diff `shouldBe`
|
||||
[ TOCSummary "Method" "foo" (sourceSpanBetween (1, 1) (4, 4)) "modified" ]
|
||||
[ TOCSummary "Method" "foo" (Span (Pos 1 1) (Pos 4 4)) "modified" ]
|
||||
|
||||
it "handles unicode characters in file" $ do
|
||||
sourceBlobs <- blobsForPaths (both "ruby/unicode.A.rb" "ruby/unicode.B.rb")
|
||||
diff <- runTask $ diffWithParser rubyParser sourceBlobs
|
||||
diffTOC diff `shouldBe`
|
||||
[ TOCSummary "Method" "foo" (sourceSpanBetween (6, 1) (7, 4)) "added" ]
|
||||
[ TOCSummary "Method" "foo" (Span (Pos 6 1) (Pos 7 4)) "added" ]
|
||||
|
||||
it "properly slices source blob that starts with a newline and has multi-byte chars" $ do
|
||||
sourceBlobs <- blobsForPaths (both "javascript/starts-with-newline.js" "javascript/starts-with-newline.js")
|
||||
diff <- runTask $ diffWithParser rubyParser sourceBlobs
|
||||
diffTOC diff `shouldBe` []
|
||||
|
||||
prop "inserts of methods and functions are summarized" $
|
||||
\name body ->
|
||||
prop "inserts of methods and functions are summarized" . forAll ((not . isMethodOrFunction . Prelude.snd) `filterT` tiers) $
|
||||
\(name, body) ->
|
||||
let diff = programWithInsert name body
|
||||
in numTocSummaries diff `shouldBe` 1
|
||||
|
||||
prop "deletes of methods and functions are summarized" $
|
||||
\name body ->
|
||||
prop "deletes of methods and functions are summarized" . forAll ((not . isMethodOrFunction . Prelude.snd) `filterT` tiers) $
|
||||
\(name, body) ->
|
||||
let diff = programWithDelete name body
|
||||
in numTocSummaries diff `shouldBe` 1
|
||||
|
||||
prop "replacements of methods and functions are summarized" $
|
||||
\name body ->
|
||||
prop "replacements of methods and functions are summarized" . forAll ((not . isMethodOrFunction . Prelude.snd) `filterT` tiers) $
|
||||
\(name, body) ->
|
||||
let diff = programWithReplace name body
|
||||
in numTocSummaries diff `shouldBe` 1
|
||||
|
||||
prop "changes inside methods and functions are summarizied" . forAll (isMeaningfulTerm `filterT` tiers) $
|
||||
prop "changes inside methods and functions are summarizied" . forAll (((&&) <$> not . isMethodOrFunction <*> isMeaningfulTerm) `filterT` tiers) $
|
||||
\body ->
|
||||
let diff = programWithChange body
|
||||
in numTocSummaries diff `shouldBe` 1
|
||||
@ -142,17 +143,16 @@ spec = parallel $ do
|
||||
let diff = programWithChangeOutsideFunction body
|
||||
in numTocSummaries diff `shouldBe` 0
|
||||
|
||||
prop "equal terms produce identity diffs" $
|
||||
\a -> let term = defaultFeatureVectorDecorator (Info.category . termFAnnotation) (a :: Term') in
|
||||
diffTOC (diffSyntaxTerms term term) `shouldBe` []
|
||||
prop "unchanged diffs aren’t summarized" $
|
||||
\term -> diffTOC (diffTerms term (term :: Term')) `shouldBe` []
|
||||
|
||||
describe "TOCSummary" $ do
|
||||
it "encodes modified summaries to JSON" $ do
|
||||
let summary = TOCSummary "Method" "foo" (sourceSpanBetween (1, 1) (4, 4)) "modified"
|
||||
let summary = TOCSummary "Method" "foo" (Span (Pos 1 1) (Pos 4 4)) "modified"
|
||||
encode summary `shouldBe` "{\"span\":{\"start\":[1,1],\"end\":[4,4]},\"category\":\"Method\",\"term\":\"foo\",\"changeType\":\"modified\"}"
|
||||
|
||||
it "encodes added summaries to JSON" $ do
|
||||
let summary = TOCSummary "Method" "self.foo" (sourceSpanBetween (1, 1) (2, 4)) "added"
|
||||
let summary = TOCSummary "Method" "self.foo" (Span (Pos 1 1) (Pos 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
|
||||
@ -177,25 +177,25 @@ spec = parallel $ do
|
||||
toOutput output `shouldBe` ("{\"changes\":{\"test/fixtures/toc/markdown/headings.A.md -> test/fixtures/toc/markdown/headings.B.md\":[{\"span\":{\"start\":[1,1],\"end\":[3,16]},\"category\":\"Heading 1\",\"term\":\"Introduction\",\"changeType\":\"removed\"},{\"span\":{\"start\":[5,1],\"end\":[7,4]},\"category\":\"Heading 2\",\"term\":\"Two\",\"changeType\":\"modified\"},{\"span\":{\"start\":[9,1],\"end\":[11,10]},\"category\":\"Heading 3\",\"term\":\"This heading is new\",\"changeType\":\"added\"},{\"span\":{\"start\":[13,1],\"end\":[14,4]},\"category\":\"Heading 1\",\"term\":\"Final\",\"changeType\":\"added\"}]},\"errors\":{}}\n" :: ByteString)
|
||||
|
||||
|
||||
type Diff' = Diff Syntax (Record (Maybe Declaration ': DefaultFields)) (Record (Maybe Declaration ': DefaultFields))
|
||||
type Term' = Term Syntax (Record (Maybe Declaration ': DefaultFields))
|
||||
type Diff' = Diff ListableSyntax (Record '[Maybe Declaration, Range, Span]) (Record '[Maybe Declaration, Range, Span])
|
||||
type Term' = Term ListableSyntax (Record '[Maybe Declaration, Range, Span])
|
||||
|
||||
numTocSummaries :: Diff' -> Int
|
||||
numTocSummaries diff = length $ filter isValidSummary (diffTOC diff)
|
||||
|
||||
-- Return a diff where body is inserted in the expressions of a function. The function is present in both sides of the diff.
|
||||
programWithChange :: Term' -> Diff'
|
||||
programWithChange body = merge (programInfo, programInfo) (Indexed [ function' ])
|
||||
programWithChange body = merge (programInfo, programInfo) (inj [ function' ])
|
||||
where
|
||||
function' = merge ((Just (FunctionDeclaration "foo" mempty Nothing) :. functionInfo, Just (FunctionDeclaration "foo" mempty Nothing) :. functionInfo)) (S.Function name' [] [ inserting body ])
|
||||
name' = let info = Nothing :. Range 0 0 :. C.Identifier :. sourceSpanBetween (0,0) (0,0) :. Nil in merge (info, info) (Leaf "foo")
|
||||
function' = merge (Just (FunctionDeclaration "foo" mempty Nothing) :. emptyInfo, Just (FunctionDeclaration "foo" mempty Nothing) :. emptyInfo) (inj (Declaration.Function [] name' [] (merge (Nothing :. emptyInfo, Nothing :. emptyInfo) (inj [ inserting body ]))))
|
||||
name' = let info = Nothing :. emptyInfo in merge (info, info) (inj (Syntax.Identifier "foo"))
|
||||
|
||||
-- Return a diff where term is inserted in the program, below a function found on both sides of the diff.
|
||||
programWithChangeOutsideFunction :: Term' -> Diff'
|
||||
programWithChangeOutsideFunction term = merge (programInfo, programInfo) (Indexed [ function', term' ])
|
||||
programWithChangeOutsideFunction term = merge (programInfo, programInfo) (inj [ function', term' ])
|
||||
where
|
||||
function' = merge (Just (FunctionDeclaration "foo" mempty Nothing) :. functionInfo, Just (FunctionDeclaration "foo" mempty Nothing) :. functionInfo) (S.Function name' [] [])
|
||||
name' = let info = Nothing :. Range 0 0 :. C.Identifier :. sourceSpanBetween (0,0) (0,0) :. Nil in merge (info, info) (Leaf "foo")
|
||||
function' = merge (Just (FunctionDeclaration "foo" mempty Nothing) :. emptyInfo, Just (FunctionDeclaration "foo" mempty Nothing) :. emptyInfo) (inj (Declaration.Function [] name' [] (merge (Nothing :. emptyInfo, Nothing :. emptyInfo) (inj []))))
|
||||
name' = let info = Nothing :. emptyInfo in merge (info, info) (inj (Syntax.Identifier "foo"))
|
||||
term' = inserting term
|
||||
|
||||
programWithInsert :: Text -> Term' -> Diff'
|
||||
@ -208,49 +208,42 @@ programWithReplace :: Text -> Term' -> Diff'
|
||||
programWithReplace name body = programOf $ replacing (functionOf name body) (functionOf (name <> "2") body)
|
||||
|
||||
programOf :: Diff' -> Diff'
|
||||
programOf diff = merge (programInfo, programInfo) (Indexed [ diff ])
|
||||
programOf diff = merge (programInfo, programInfo) (inj [ diff ])
|
||||
|
||||
functionOf :: Text -> Term' -> Term'
|
||||
functionOf name body = Term $ (Just (FunctionDeclaration name mempty Nothing) :. functionInfo) `In` S.Function name' [] [body]
|
||||
functionOf name body = termIn (Just (FunctionDeclaration name mempty Nothing) :. emptyInfo) (inj (Declaration.Function [] name' [] (termIn (Nothing :. emptyInfo) (inj [body]))))
|
||||
where
|
||||
name' = Term $ (Nothing :. Range 0 0 :. C.Identifier :. sourceSpanBetween (0,0) (0,0) :. Nil) `In` Leaf name
|
||||
name' = termIn (Nothing :. emptyInfo) (inj (Syntax.Identifier (encodeUtf8 name)))
|
||||
|
||||
programInfo :: Record (Maybe Declaration ': DefaultFields)
|
||||
programInfo = Nothing :. Range 0 0 :. C.Program :. sourceSpanBetween (0,0) (0,0) :. Nil
|
||||
programInfo :: Record '[Maybe Declaration, Range, Span]
|
||||
programInfo = Nothing :. emptyInfo
|
||||
|
||||
functionInfo :: Record DefaultFields
|
||||
functionInfo = Range 0 0 :. C.Function :. sourceSpanBetween (0,0) (0,0) :. Nil
|
||||
emptyInfo :: Record '[Range, Span]
|
||||
emptyInfo = Range 0 0 :. Span (Pos 0 0) (Pos 0 0) :. Nil
|
||||
|
||||
-- Filter tiers for terms that we consider "meaniningful" in TOC summaries.
|
||||
isMeaningfulTerm :: Term Syntax a -> Bool
|
||||
isMeaningfulTerm a = case unTerm a of
|
||||
(_ `In` S.Indexed _) -> False
|
||||
(_ `In` S.Fixed _) -> False
|
||||
(_ `In` S.Commented _ _) -> False
|
||||
(_ `In` S.ParseError _) -> False
|
||||
_ -> True
|
||||
isMeaningfulTerm :: Term ListableSyntax a -> Bool
|
||||
isMeaningfulTerm a
|
||||
| Just (_:_) <- prj (termOut a) = False
|
||||
| Just [] <- prj (termOut a) = False
|
||||
| otherwise = True
|
||||
|
||||
-- Filter tiers for terms if the Syntax is a Method or a Function.
|
||||
isMethodOrFunction :: HasField fields Category => Term Syntax (Record fields) -> Bool
|
||||
isMethodOrFunction a = case unTerm a of
|
||||
(_ `In` S.Method{}) -> True
|
||||
(_ `In` S.Function{}) -> True
|
||||
(a `In` _) | getField a == C.Function -> True
|
||||
(a `In` _) | getField a == C.Method -> True
|
||||
(a `In` _) | getField a == C.SingletonMethod -> True
|
||||
_ -> False
|
||||
isMethodOrFunction :: Term' -> Bool
|
||||
isMethodOrFunction a
|
||||
| Just Declaration.Method{} <- prj (termOut a) = True
|
||||
| Just Declaration.Function{} <- prj (termOut a) = True
|
||||
| any isJust (foldMap ((:[]) . rhead) a) = True
|
||||
| otherwise = False
|
||||
|
||||
blobsForPaths :: Both FilePath -> IO BlobPair
|
||||
blobsForPaths = readFilePair . fmap ("test/fixtures/toc/" <>)
|
||||
|
||||
sourceSpanBetween :: (Int, Int) -> (Int, Int) -> Span
|
||||
sourceSpanBetween (s1, e1) (s2, e2) = Span (Pos s1 e1) (Pos s2 e2)
|
||||
|
||||
blankDiff :: Diff'
|
||||
blankDiff = merge (arrayInfo, arrayInfo) (Indexed [ inserting (Term $ literalInfo `In` Leaf "\"a\"") ])
|
||||
blankDiff = merge (arrayInfo, arrayInfo) (inj [ inserting (termIn literalInfo (inj (Syntax.Identifier "\"a\""))) ])
|
||||
where
|
||||
arrayInfo = Nothing :. Range 0 3 :. ArrayLiteral :. sourceSpanBetween (1, 1) (1, 5) :. Nil
|
||||
literalInfo = Nothing :. Range 1 2 :. StringLiteral :. sourceSpanBetween (1, 2) (1, 4) :. Nil
|
||||
arrayInfo = Nothing :. Range 0 3 :. Span (Pos 1 1) (Pos 1 5) :. Nil
|
||||
literalInfo = Nothing :. Range 1 2 :. Span (Pos 1 2) (Pos 1 4) :. Nil
|
||||
|
||||
blankDiffBlobs :: Both Blob
|
||||
blankDiffBlobs = both (Blob (fromText "[]") "a.js" (Just TypeScript)) (Blob (fromText "[a]") "b.js" (Just TypeScript))
|
||||
|
@ -54,7 +54,7 @@ diffFixtures :: [(SomeRenderer DiffRenderer, Either Handle [Both (FilePath, Mayb
|
||||
diffFixtures =
|
||||
[ (SomeRenderer JSONDiffRenderer, pathMode, jsonOutput)
|
||||
, (SomeRenderer SExpressionDiffRenderer, pathMode, sExpressionOutput)
|
||||
, (SomeRenderer OldToCDiffRenderer, pathMode, tocOutput)
|
||||
, (SomeRenderer ToCDiffRenderer, pathMode, tocOutput)
|
||||
]
|
||||
where pathMode = Right [both ("test/fixtures/ruby/method-declaration.A.rb", Just Ruby) ("test/fixtures/ruby/method-declaration.B.rb", Just Ruby)]
|
||||
|
||||
|
@ -10,7 +10,6 @@ import Data.Term
|
||||
import Rendering.Renderer
|
||||
import Semantic
|
||||
import Semantic.Task
|
||||
import Syntax
|
||||
import System.Exit
|
||||
import Test.Hspec hiding (shouldBe, shouldNotBe, shouldThrow, errorCall)
|
||||
import Test.Hspec.Expectations.Pretty
|
||||
|
Loading…
Reference in New Issue
Block a user