1
1
mirror of https://github.com/github/semantic.git synced 2024-12-25 16:02:43 +03:00

Merge remote-tracking branch 'origin/master' into php-assignment

This commit is contained in:
joshvera 2017-12-19 17:29:00 -05:00
commit c25a478d1f
113 changed files with 1142 additions and 1765 deletions

View File

@ -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
@ -86,6 +83,7 @@ library
, Parsing.TreeSitter
, Paths_semantic_diff
-- Rendering formats
, Rendering.DOT
, Rendering.JSON
, Rendering.Renderer
, Rendering.SExpression
@ -100,7 +98,6 @@ library
, Semantic.Task
, Semantic.Queue
, Semantic.Util
, Syntax
build-depends: base >= 4.8 && < 5
, aeson
, ansi-terminal

View File

@ -19,7 +19,7 @@ constructorLabel :: ConstructorName syntax => TermF syntax a b -> ConstructorLab
constructorLabel (In _ s) = ConstructorLabel $ pack (constructorName s)
newtype ConstructorLabel = ConstructorLabel ByteString
newtype ConstructorLabel = ConstructorLabel { unConstructorLabel :: ByteString }
instance Show ConstructorLabel where
showsPrec _ (ConstructorLabel s) = showString (unpack s)

View File

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

View File

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

View File

@ -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
@ -218,7 +219,7 @@ nodeError expected Node{..} = Error nodeSpan expected (Just (Right nodeSymbol))
firstSet :: (Enum grammar, Ix grammar) => Assignment ast grammar a -> [grammar]
firstSet = iterFreer (\ (Tracing _ assignment) _ -> case assignment of
firstSet = iterFreer (\ _ (Tracing _ assignment) -> case assignment of
Choose table _ _ -> Table.tableAddresses table
Label child _ -> firstSet child
_ -> []) . ([] <$)
@ -245,11 +246,11 @@ runAssignment source = \ assignment state -> go assignment state >>= requireExha
go assignment = iterFreer run ((pure .) . (,) <$> assignment)
{-# INLINE go #-}
run :: Tracing (AssignmentF ast grammar) x
-> (x -> State ast grammar -> Either (Error (Either String grammar)) (result, State ast grammar))
run :: (x -> State ast grammar -> Either (Error (Either String grammar)) (result, State ast grammar))
-> Tracing (AssignmentF ast grammar) x
-> State ast grammar
-> Either (Error (Either String grammar)) (result, State ast grammar)
run t yield initialState = state `seq` maybe (anywhere Nothing) atNode (listToMaybe stateNodes)
run yield t initialState = state `seq` maybe (anywhere Nothing) atNode (listToMaybe stateNodes)
where atNode (Term (In node f)) = case runTracing t of
Location -> yield (nodeLocation node) state
CurrentNode -> yield (In node (() <$ f)) state
@ -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
@ -367,7 +368,7 @@ instance (Enum grammar, Eq1 ast, Ix grammar, Show grammar) => MonadError (Error
throwError err = fail (show err)
catchError :: HasCallStack => Assignment ast grammar a -> (Error (Either String grammar) -> Assignment ast grammar a) -> Assignment ast grammar a
catchError rule handler = iterFreer (\ (Tracing cs assignment) continue -> case assignment of
catchError rule handler = iterFreer (\ continue (Tracing cs assignment) -> case assignment of
Choose choices atEnd Nothing -> Tracing cs (Choose (fmap (>>= continue) choices) (fmap (>>= continue) atEnd) (Just handler)) `Then` return
Choose choices atEnd (Just onError) -> Tracing cs (Choose (fmap (>>= continue) choices) (fmap (>>= continue) atEnd) (Just (\ err -> (onError err >>= continue) <|> handler err))) `Then` return
_ -> Tracing cs assignment `Then` ((`catchError` handler) . continue)) (fmap pure rule)
@ -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

View File

@ -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 Rubys @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. Rubys 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) }]

View File

@ -1,56 +1,62 @@
module Data.Blob
( Blob(..)
, BlobKind(..)
, modeToDigits
, defaultPlainBlob
, emptyBlob
, nullBlob
, blobExists
, sourceBlob
, nullOid
, BlobPair
, These(..)
, blobPairDiffing
, blobPairInserting
, blobPairDeleting
, languageForBlobPair
, languageTagForBlobPair
, pathForBlobPair
) where
import Data.ByteString.Char8 (ByteString, pack)
import Data.Bifunctor.Join
import Data.Language
import Data.Maybe (isJust)
import Data.These
import Data.Source as Source
import Data.Word
import Numeric
-- | The source, oid, path, and Maybe BlobKind of a blob.
-- | The source, path, and language of a blob.
data Blob = Blob
{ blobSource :: Source -- ^ The UTF-8 encoded source text of the blob.
, blobOid :: ByteString -- ^ The Git object ID (SHA-1) of the blob.
, blobPath :: FilePath -- ^ The file path to the blob.
, blobKind :: Maybe BlobKind -- ^ The kind of blob, Nothing denotes a blob that doesn't exist (e.g. on one side of a diff for adding a new file or deleting a file).
, blobLanguage :: Maybe Language -- ^ The language of this blob. Nothing denotes a langauge we don't support yet.
}
deriving (Show, Eq)
-- | The kind and file mode of a 'Blob'.
data BlobKind = PlainBlob Word32 | ExecutableBlob Word32 | SymlinkBlob Word32
deriving (Show, Eq)
modeToDigits :: BlobKind -> ByteString
modeToDigits (PlainBlob mode) = pack $ showOct mode ""
modeToDigits (ExecutableBlob mode) = pack $ showOct mode ""
modeToDigits (SymlinkBlob mode) = pack $ showOct mode ""
-- | The default plain blob mode
defaultPlainBlob :: BlobKind
defaultPlainBlob = PlainBlob 0o100644
emptyBlob :: FilePath -> Blob
emptyBlob filepath = Blob mempty nullOid filepath Nothing Nothing
nullBlob :: Blob -> Bool
nullBlob Blob{..} = blobOid == nullOid || nullSource blobSource
blobExists :: Blob -> Bool
blobExists Blob{..} = isJust blobKind
nullBlob Blob{..} = nullSource blobSource
sourceBlob :: FilePath -> Maybe Language -> Source -> Blob
sourceBlob filepath language source = Blob source nullOid filepath (Just defaultPlainBlob) language
sourceBlob filepath language source = Blob source filepath language
nullOid :: ByteString
nullOid = "0000000000000000000000000000000000000000"
-- | Represents a blobs suitable for diffing which can be either a blob to
-- delete, a blob to insert, or a pair of blobs to diff.
type BlobPair = Join These Blob
blobPairDiffing :: Blob -> Blob -> BlobPair
blobPairDiffing a b = Join (These a b)
blobPairInserting :: Blob -> BlobPair
blobPairInserting = Join . That
blobPairDeleting :: Blob -> BlobPair
blobPairDeleting = Join . This
languageForBlobPair :: BlobPair -> Maybe Language
languageForBlobPair (Join (This Blob{..})) = blobLanguage
languageForBlobPair (Join (That Blob{..})) = blobLanguage
languageForBlobPair (Join (These _ Blob{..})) = blobLanguage
pathForBlobPair :: BlobPair -> FilePath
pathForBlobPair (Join (This Blob{..})) = blobPath
pathForBlobPair (Join (That Blob{..})) = blobPath
pathForBlobPair (Join (These _ Blob{..})) = blobPath
languageTagForBlobPair :: BlobPair -> [(String, String)]
languageTagForBlobPair pair = maybe [] showLanguage (languageForBlobPair pair)
where showLanguage = pure . (,) "language" . show

View File

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

View File

@ -39,7 +39,7 @@ type Colourize = Bool
formatError :: IncludeSource -> Colourize -> Blob -> Error String -> String
formatError includeSource colourize Blob{..} Error{..}
= ($ "")
$ withSGRCode colourize [SetConsoleIntensity BoldIntensity] (showSpan (maybe Nothing (const (Just blobPath)) blobKind) errorSpan . showString ": ")
$ withSGRCode colourize [SetConsoleIntensity BoldIntensity] (showSpan (Just blobPath) errorSpan . showString ": ")
. withSGRCode colourize [SetColor Foreground Vivid Red] (showString "error") . showString ": " . showExpectation colourize errorExpected errorActual . showChar '\n'
. (if includeSource
then showString (unpack context) . (if "\n" `isSuffixOf` context then id else showChar '\n')

View File

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

View File

@ -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 (\ step yield -> 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)

View File

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

View File

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

View File

@ -117,7 +117,8 @@ expression = term (handleError (choice expressionChoices))
expressionChoices :: [Assignment.Assignment [] Grammar Term]
expressionChoices =
[ assignment'
[ argumentList
, assignment'
, binaryExpression
, block
, breakStatement
@ -138,6 +139,7 @@ expressionChoices =
, expressionSwitchStatement
, fallThroughStatement
, fieldDeclaration
, fieldDeclarationList
, fieldIdentifier
, floatLiteral
, forStatement
@ -151,6 +153,7 @@ expressionChoices =
, identifier
, importDeclaration
, importSpec
, importSpecList
, indexExpression
, interpretedStringLiteral
, intLiteral
@ -160,6 +163,7 @@ expressionChoices =
, literalValue
, methodDeclaration
, methodSpec
, methodSpecList
, packageClause
, packageIdentifier
, parameterDeclaration
@ -285,6 +289,9 @@ fieldDeclaration = mkFieldDeclarationWithTag <$> symbol FieldDeclaration <*> ch
| Just tag' <- tag = makeTerm loc (Go.Syntax.Field [tag'] (makeTerm loc fields))
| otherwise = makeTerm loc (Go.Syntax.Field [] (makeTerm loc fields))
fieldDeclarationList :: Assignment
fieldDeclarationList = symbol FieldDeclarationList *> children expressions
functionType :: Assignment
functionType = makeTerm <$> symbol FunctionType <*> children (Type.Function <$> manyTerm parameters <*> (expression <|> emptyTerm))
@ -320,6 +327,9 @@ typeDeclaration = makeTerm <$> symbol TypeDeclaration <*> children (manyTerm ( (
-- Expressions
argumentList :: Assignment
argumentList = (symbol ArgumentList <|> symbol ArgumentList') *> children expressions
binaryExpression :: Assignment
binaryExpression = makeTerm' <$> symbol BinaryExpression <*> children (infixTerm expression expression
[ (inj .) . Expression.Plus <$ symbol AnonPlus
@ -376,7 +386,7 @@ functionDeclaration :: Assignment
functionDeclaration = makeTerm <$> (symbol FunctionDeclaration <|> symbol FuncLiteral) <*> children (mkFunctionDeclaration <$> (term identifier <|> emptyTerm) <*> manyTerm parameters <*> (term types <|> term identifier <|> term returnParameters <|> emptyTerm) <*> (term block <|> emptyTerm))
where
mkFunctionDeclaration name' params' types' block' = Declaration.Function [types'] name' params' block'
returnParameters = makeTerm <$> symbol Parameters <*> children (manyTerm expression)
returnParameters = makeTerm <$> symbol ParameterList <*> children (manyTerm expression)
importDeclaration :: Assignment
importDeclaration = makeTerm <$> symbol ImportDeclaration <*> children (Declaration.Import <$> manyTerm expression)
@ -384,13 +394,16 @@ importDeclaration = makeTerm <$> symbol ImportDeclaration <*> children (Declarat
importSpec :: Assignment
importSpec = symbol ImportSpec *> children expressions
importSpecList :: Assignment
importSpecList = symbol ImportSpecList *> children expressions
indexExpression :: Assignment
indexExpression = makeTerm <$> symbol IndexExpression <*> children (Expression.Subscript <$> expression <*> manyTerm expression)
methodDeclaration :: Assignment
methodDeclaration = makeTerm <$> symbol MethodDeclaration <*> children (mkTypedMethodDeclaration <$> receiver <*> term fieldIdentifier <*> manyTerm parameters <*> ((makeTerm <$> location <*> (manyTermsTill expression (void (symbol Block)))) <|> emptyTerm) <*> (term block <|> emptyTerm))
where
receiver = symbol Parameters *> children ((symbol ParameterDeclaration *> children expressions) <|> expressions)
receiver = symbol ParameterList *> children ((symbol ParameterDeclaration *> children expressions) <|> expressions)
mkTypedMethodDeclaration receiver' name' parameters' type'' body' = Declaration.Method [type''] receiver' name' parameters' body'
methodSpec :: Assignment
@ -398,11 +411,14 @@ methodSpec = makeTerm <$> symbol MethodSpec <*> children (mkMethodSpec <$> expr
where
mkMethodSpec name' params optionalTypeLiteral = Declaration.MethodSignature [optionalTypeLiteral] name' [params]
methodSpecList :: Assignment
methodSpecList = symbol MethodSpecList *> children expressions
packageClause :: Assignment
packageClause = makeTerm <$> symbol PackageClause <*> children (Declaration.Module <$> expression <*> pure [])
parameters :: Assignment
parameters = symbol Parameters *> children expressions
parameters = symbol ParameterList *> children expressions
parameterDeclaration :: Assignment
parameterDeclaration = makeTerm <$> symbol ParameterDeclaration <*> children (manyTerm expression)

View File

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

View File

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

View File

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

74
src/Rendering/DOT.hs Normal file
View File

@ -0,0 +1,74 @@
{-# LANGUAGE MonoLocalBinds #-}
module Rendering.DOT
( renderDOTDiff
, renderDOTTerm
) where
import Analysis.ConstructorName
import Control.Applicative
import Data.Bifunctor.Join (Join(..))
import Data.Blob
import qualified Data.ByteString.Char8 as B
import Data.Diff
import Data.Foldable
import Data.Functor.Foldable hiding (fold)
import qualified Data.Map as Map
import Data.Patch
import Data.Semigroup
import Data.Term
import Data.These (These, mergeThese)
renderDOTDiff :: (ConstructorName syntax, Foldable syntax, Functor syntax) => Join These Blob -> Diff syntax ann1 ann2 -> B.ByteString
renderDOTDiff blobs diff = renderGraph (snd (cata diffAlgebra diff 0)) { graphName = Just (B.pack (mergeThese combine (runJoin (blobPath <$> blobs)))) }
where combine p1 p2 = p1 <> " -> " <> p2
renderDOTTerm :: (ConstructorName syntax, Foldable syntax, Functor syntax) => Blob -> Term syntax ann -> B.ByteString
renderDOTTerm Blob{..} term = renderGraph (snd (cata termAlgebra term 0)) { graphName = Just (B.pack blobPath) }
diffAlgebra :: (ConstructorName syntax, Foldable syntax) => DiffF syntax ann1 ann2 (Int -> ([Int], Graph)) -> Int -> ([Int], Graph)
diffAlgebra d i = case d of
Merge t -> termAlgebra t i
Patch (Delete t1) -> termAlgebra t1 i `modifyHeadNode` setColour "red"
Patch (Insert t2) -> termAlgebra t2 i `modifyHeadNode` setColour "green"
Patch (Replace t1 t2) -> let r1 = termAlgebra t1 i `modifyHeadNode` setColour "red"
in r1 <> termAlgebra t2 (succ (maximum (i : map nodeID (graphNodes (snd r1))))) `modifyHeadNode` setColour "green"
where modifyHeadNode (i, g) f | n:ns <- graphNodes g = (i, g { graphNodes = f n : ns })
| otherwise = (i, g)
setColour c n = n { nodeAttributes = Map.insert "color" c (nodeAttributes n) }
termAlgebra :: (ConstructorName syntax, Foldable syntax) => TermF syntax ann (Int -> ([Int], Graph)) -> Int -> ([Int], Graph)
termAlgebra t i = ([succ i], Graph
Nothing
(Node (succ i) (Map.singleton "label" (unConstructorLabel (constructorLabel t))) : graphNodes g)
(concatMap (map (Edge (succ i))) is <> graphEdges g))
where (_, is, g) = foldr combine (succ i, [], mempty) (toList t)
combine f (i, is, gs) = let (i', g) = f i in (maximum (i : map nodeID (graphNodes g)), i' : is, g <> gs)
data Graph = Graph { graphName :: Maybe B.ByteString, graphNodes :: [Node], graphEdges :: [Edge] }
deriving (Eq, Ord, Show)
data Node = Node { nodeID :: Int, nodeAttributes :: Map.Map B.ByteString B.ByteString }
deriving (Eq, Ord, Show)
data Edge = Edge { edgeFrom :: Int, edgeTo :: Int }
deriving (Eq, Ord, Show)
renderGraph :: Graph -> B.ByteString
renderGraph Graph{..} = "digraph " <> maybe "" quote graphName <> " {\n" <> foldr ((<>) . renderNode) "" graphNodes <> foldr ((<>) . renderEdge) "" graphEdges <> "}"
where quote a = "\"" <> a <> "\""
renderNode :: Node -> B.ByteString
renderNode Node{..} = "\t" <> B.pack (show nodeID) <> " [ " <> foldr (\ (key, value) rest -> key <> " = \"" <> value <> "\" " <> rest) "" (Map.toList nodeAttributes) <> "];\n"
renderEdge :: Edge -> B.ByteString
renderEdge Edge{..} = "\t" <> B.pack (show edgeFrom) <> " -> " <> B.pack (show edgeTo) <> ";\n"
instance Semigroup Graph where
Graph n1 ns1 es1 <> Graph n2 ns2 es2 = Graph (n1 <|> n2) (ns1 <> ns2) (es1 <> es2)
instance Monoid Graph where
mempty = Graph Nothing [] []
mappend = (<>)

View File

@ -4,26 +4,20 @@ module Rendering.JSON
) where
import Data.Aeson (ToJSON, toJSON, object, (.=))
import Data.Aeson as A hiding (json)
import Data.Aeson as A
import Data.Blob
import Data.Foldable (toList)
import Data.Functor.Both (Both)
import Data.Bifoldable (biList)
import Data.Bifunctor.Join
import Data.Language
import qualified Data.Map as Map
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8)
import GHC.Generics
--
-- Diffs
--
-- | Render a diff to a string representing its JSON.
renderJSONDiff :: ToJSON a => Both Blob -> a -> Map.Map Text Value
renderJSONDiff :: ToJSON a => BlobPair -> a -> Map.Map Text Value
renderJSONDiff blobs diff = Map.fromList
[ ("diff", toJSON diff)
, ("oids", toJSON (decodeUtf8 . blobOid <$> toList blobs))
, ("paths", toJSON (blobPath <$> toList blobs))
, ("paths", toJSON (blobPath <$> (biList . runJoin) blobs))
]
data File a = File { filePath :: FilePath, fileLanguage :: Maybe Language, fileContent :: a }
@ -32,5 +26,6 @@ data File a = File { filePath :: FilePath, fileLanguage :: Maybe Language, fileC
instance ToJSON a => ToJSON (File a) where
toJSON File{..} = object [ "filePath" .= filePath, "language" .= fileLanguage, "programNode" .= fileContent ]
-- | Render a term to a string representing its JSON.
renderJSONTerm :: ToJSON a => Blob -> a -> [Value]
renderJSONTerm Blob{..} = pure . toJSON . File blobPath blobLanguage

View File

@ -10,6 +10,8 @@ module Rendering.Renderer
, renderToCDiff
, renderToCTerm
, renderToTags
, renderDOTDiff
, renderDOTTerm
, Summaries(..)
) where
@ -18,6 +20,7 @@ import Data.ByteString (ByteString)
import qualified Data.Map as Map
import Data.Output
import Data.Text (Text)
import Rendering.DOT as R
import Rendering.JSON as R
import Rendering.SExpression as R
import Rendering.Tag as R
@ -26,13 +29,13 @@ 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)
-- | Render to a 'ByteString' formatted as nested s-expressions with patches indicated.
SExpressionDiffRenderer :: DiffRenderer ByteString
-- | Render to a 'ByteString' formatted as a DOT description of the diff.
DOTDiffRenderer :: DiffRenderer ByteString
deriving instance Eq (DiffRenderer output)
deriving instance Show (DiffRenderer output)
@ -47,6 +50,8 @@ data TermRenderer output where
SExpressionTermRenderer :: TermRenderer ByteString
-- | Render to a list of tags.
TagsTermRenderer :: TermRenderer [Value]
-- | Render to a 'ByteString' formatted as a DOT description of the term.
DOTTermRenderer :: TermRenderer ByteString
deriving instance Eq (TermRenderer output)
deriving instance Show (TermRenderer output)

View File

@ -21,26 +21,26 @@ import Data.Aeson
import Data.Align (bicrosswalk)
import Data.Bifoldable (bifoldMap)
import Data.Bifunctor (bimap)
import Data.Bifunctor.Join
import Data.Blob
import Data.ByteString.Lazy (toStrict)
import Data.Diff
import Data.Foldable (fold, foldl')
import Data.Functor.Both hiding (fst, snd)
import Data.Functor.Foldable (cata)
import Data.Function (on)
import Data.Language as Language
import Data.List (sortOn)
import qualified Data.List as List
import qualified Data.Map as Map hiding (null)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe, mapMaybe)
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,23 +152,23 @@ 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
formatIdentifier (MethodDeclaration identifier _ _ (Just receiver)) = receiver <> "." <> identifier
formatIdentifier declaration = declarationIdentifier declaration
renderToCDiff :: (HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => Both Blob -> Diff f (Record fields) (Record fields) -> Summaries
renderToCDiff :: (HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => BlobPair -> Diff f (Record fields) (Record fields) -> Summaries
renderToCDiff blobs = uncurry Summaries . bimap toMap toMap . List.partition isValidSummary . diffTOC
where toMap [] = mempty
toMap as = Map.singleton summaryKey (toJSON <$> as)
summaryKey = T.pack $ case runJoin (blobPath <$> blobs) of
(before, after) | null before -> after
| null after -> before
| before == after -> after
| otherwise -> before <> " -> " <> after
summaryKey = T.pack $ case bimap blobPath blobPath (runJoin blobs) of
This before -> before
That after -> after
These before after | before == after -> after
| otherwise -> before <> " -> " <> after
diffTOC :: (HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => Diff f (Record fields) (Record fields) -> [TOCSummary]
diffTOC = mapMaybe entrySummary . dedupe . tableOfContentsBy declaration

View File

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

View File

@ -9,27 +9,24 @@ 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
import Data.Bifunctor.Join
import Data.Blob
import Data.ByteString (ByteString)
import Data.Diff
import Data.Functor.Both as Both
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
@ -45,87 +42,52 @@ import Semantic.Task as Task
-- - Easy to consume this interface from other application (e.g a cmdline or web server app).
parseBlobs :: Output output => TermRenderer output -> [Blob] -> Task ByteString
parseBlobs renderer = fmap toOutput . distributeFoldMap (parseBlob renderer) . filter blobExists
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)
| otherwise = throwError (SomeException (NoParserForLanguage blobPath blobLanguage))
data NoParserForLanguage = NoParserForLanguage FilePath (Maybe Language.Language)
data NoLanguageForBlob = NoLanguageForBlob FilePath
deriving (Eq, Exception, Ord, Show, Typeable)
diffBlobPairs :: Output output => DiffRenderer output -> [Both Blob] -> Task ByteString
diffBlobPairs renderer = fmap toOutput . distributeFoldMap (diffBlobPair renderer) . filter (any blobExists)
diffBlobPairs :: Output output => DiffRenderer output -> [BlobPair] -> Task ByteString
diffBlobPairs renderer = fmap toOutput . distributeFoldMap (diffBlobPair renderer)
-- | A task to parse a pair of 'Blob's, diff them, and render the 'Diff'.
diffBlobPair :: DiffRenderer output -> Both Blob -> Task output
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)
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)
| otherwise = throwError (SomeException (NoParserForLanguage effectivePath effectiveLanguage))
where (effectivePath, effectiveLanguage) = case runJoin blobs of
(Blob { blobLanguage = Just lang, blobPath = path }, _) -> (path, Just lang)
(_, Blob { blobLanguage = Just lang, blobPath = path }) -> (path, Just lang)
(Blob { blobPath = path }, _) -> (path, Nothing)
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) -> (Both 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 <- distributeFor blobs parse
terms <- bidistributeFor (runJoin blobs) parse parse
time "diff" languageTag $ do
diff <- runBothWith (diffTermPair blobs diff) terms
diff <- diffTermPair diff terms
writeStat (Stat.count "diff.nodes" (bilength diff) languageTag)
render (renderer blobs) diff
where
showLanguage = pure . (,) "language" . show
languageTag = let (a, b) = runJoin blobs
in maybe (maybe [] showLanguage (blobLanguage b)) showLanguage (blobLanguage a)
languageTag = languageTagForBlobPair blobs
-- | A task to diff a pair of 'Term's, producing insertion/deletion 'Patch'es for non-existent 'Blob's.
diffTermPair :: Functor syntax => Both Blob -> Differ syntax ann1 ann2 -> Term syntax ann1 -> Term syntax ann2 -> Task (Diff syntax ann1 ann2)
diffTermPair blobs differ t1 t2 = case runJoin (blobExists <$> blobs) of
(True, False) -> pure (deleting t1)
(False, True) -> pure (inserting t2)
_ -> diff differ t1 t2
keepCategory :: HasField fields Category => Record fields -> Record '[Category]
keepCategory = (:. Nil) . category
-- | A task to diff 'Term's, producing insertion/deletion 'Patch'es for non-existent 'Blob's.
diffTermPair :: Functor syntax => Differ syntax ann1 ann2 -> These (Term syntax ann1) (Term syntax ann2) -> Task (Diff syntax ann1 ann2)
diffTermPair _ (This t1 ) = pure (deleting t1)
diffTermPair _ (That t2) = pure (inserting t2)
diffTermPair differ (These t1 t2) = diff differ t1 t2

View File

@ -64,8 +64,9 @@ 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-assignment" <> help "Output JSON table of contents diff summary using the assignment parser") )
<|> 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
<$> argument filePathReader (metavar "FILE_A")
<*> argument filePathReader (metavar "FILE_B"))
@ -76,7 +77,8 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar
<$> ( flag (SomeRenderer SExpressionTermRenderer) (SomeRenderer SExpressionTermRenderer) (long "sexpression" <> help "Output s-expression parse trees (default)")
<|> flag' (SomeRenderer JSONTermRenderer) (long "json" <> help "Output JSON parse trees")
<|> flag' (SomeRenderer ToCTermRenderer) (long "toc" <> help "Output JSON table of contents summary")
<|> flag' (SomeRenderer TagsTermRenderer) (long "tags" <> help "Output JSON tags/symbols"))
<|> flag' (SomeRenderer TagsTermRenderer) (long "tags" <> help "Output JSON tags/symbols")
<|> flag' (SomeRenderer DOTTermRenderer) (long "dot" <> help "Output the term as a DOT graph"))
<*> ( Right <$> some (argument filePathReader (metavar "FILES..."))
<|> pure (Left stdin) )

View File

@ -1,6 +1,7 @@
{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, DeriveAnyClass, DuplicateRecordFields, ScopedTypeVariables, TupleSections #-}
module Semantic.IO
( readFile
, readFilePair
, isDirectory
, readBlobPairsFromHandle
, readBlobsFromHandle
@ -9,7 +10,6 @@ module Semantic.IO
, languageForFilePath
) where
import Control.Exception (catch, IOException)
import Control.Monad.IO.Class
import Data.Aeson
import qualified Data.Blob as Blob
@ -21,6 +21,7 @@ import Data.Source
import Data.String
import Data.Text
import Data.These
import Data.Traversable
import GHC.Generics
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
@ -33,11 +34,21 @@ import System.Directory (doesDirectoryExist)
import Text.Read
-- | Read a utf8-encoded file to a 'Blob'.
readFile :: forall m. MonadIO m => FilePath -> Maybe Language -> m Blob.Blob
readFile path@"/dev/null" _ = pure (Blob.emptyBlob path)
readFile :: forall m. MonadIO m => FilePath -> Maybe Language -> m (Maybe Blob.Blob)
readFile "/dev/null" _ = pure Nothing
readFile path language = do
raw <- liftIO $ (Just <$> B.readFile path) `catch` (const (pure Nothing) :: IOException -> IO (Maybe B.ByteString))
pure $ fromMaybe (Blob.emptyBlob path) (Blob.sourceBlob path language . fromBytes <$> raw)
raw <- liftIO $ (Just <$> B.readFile path)
pure $ Blob.sourceBlob path language . fromBytes <$> raw
readFilePair :: forall m. MonadIO m => (FilePath, Maybe Language) -> (FilePath, Maybe Language) -> m Blob.BlobPair
readFilePair a b = do
before <- uncurry readFile a
after <- uncurry readFile b
case (before, after) of
(Just a, Nothing) -> pure (Join (This a))
(Nothing, Just b) -> pure (Join (That b))
(Just a, Just b) -> pure (Join (These a b))
_ -> fail "expected file pair with content on at least one side"
isDirectory :: MonadIO m => FilePath -> m Bool
isDirectory path = liftIO (doesDirectoryExist path) >>= pure
@ -47,12 +58,12 @@ languageForFilePath :: FilePath -> Maybe Language
languageForFilePath = languageForType . takeExtension
-- | Read JSON encoded blob pairs from a handle.
readBlobPairsFromHandle :: MonadIO m => Handle -> m [Both Blob.Blob]
readBlobPairsFromHandle :: MonadIO m => Handle -> m [Blob.BlobPair]
readBlobPairsFromHandle = fmap toBlobPairs . readFromHandle
where
toBlobPairs :: BlobDiff -> [Blob.BlobPair]
toBlobPairs BlobDiff{..} = toBlobPair <$> blobs
toBlobPair blobs = Join (fromThese empty empty (runJoin (toBlob <$> blobs)))
where empty = Blob.emptyBlob (mergeThese const (runJoin (path <$> blobs)))
toBlobPair blobs = toBlob <$> blobs
-- | Read JSON encoded blobs from a handle.
readBlobsFromHandle :: MonadIO m => Handle -> m [Blob.Blob]
@ -60,13 +71,14 @@ readBlobsFromHandle = fmap toBlobs . readFromHandle
where toBlobs BlobParse{..} = fmap toBlob blobs
readBlobsFromPaths :: MonadIO m => [(FilePath, Maybe Language)] -> m [Blob.Blob]
readBlobsFromPaths = traverse (uncurry Semantic.IO.readFile)
readBlobsFromPaths files = traverse (uncurry Semantic.IO.readFile) files >>= pure . catMaybes
readBlobsFromDir :: MonadIO m => FilePath -> m [Blob.Blob]
readBlobsFromDir path = do
paths <- liftIO (globDir1 (compile "[^vendor]**/*[.rb|.js|.tsx|.go|.py]") path)
let paths' = catMaybes $ fmap (\p -> (p,) . Just <$> languageForFilePath p) paths
traverse (uncurry readFile) paths'
blobs <- traverse (uncurry readFile) paths'
pure (catMaybes blobs)
readFromHandle :: (FromJSON a, MonadIO m) => Handle -> m a
readFromHandle h = do

View File

@ -17,6 +17,8 @@ module Semantic.Task
, distribute
, distributeFor
, distributeFoldMap
, bidistribute
, bidistributeFor
, defaultOptions
, configureOptionsForHandle
, terminalFormatter
@ -41,13 +43,14 @@ import Data.Diff
import qualified Data.Error as Error
import Data.Foldable (fold, for_)
import Data.Functor.Both as Both hiding (snd)
import Data.Bitraversable
import Data.Bifunctor
import Data.Functor.Foldable (cata)
import Data.Language
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
@ -61,7 +64,7 @@ import Semantic.Queue
data TaskF output where
ReadBlobs :: Either Handle [(FilePath, Maybe Language)] -> TaskF [Blob]
ReadBlobPairs :: Either Handle [Both (FilePath, Maybe Language)] -> TaskF [Both Blob]
ReadBlobPairs :: Either Handle [Both (FilePath, Maybe Language)] -> TaskF [BlobPair]
WriteToOutput :: Either Handle FilePath -> B.ByteString -> TaskF ()
WriteLog :: Level -> String -> [(String, String)] -> TaskF ()
WriteStat :: Stat -> TaskF ()
@ -71,6 +74,7 @@ data TaskF output where
Diff :: Differ syntax ann1 ann2 -> Term syntax ann1 -> Term syntax ann2 -> TaskF (Diff syntax ann1 ann2)
Render :: Renderer input output -> input -> TaskF output
Distribute :: Traversable t => t (Task output) -> TaskF (t output)
Bidistribute :: Bitraversable t => t (Task output1) (Task output2) -> TaskF (t output1 output2)
-- | For MonadIO.
LiftIO :: IO a -> TaskF a
@ -93,7 +97,7 @@ readBlobs :: Either Handle [(FilePath, Maybe Language)] -> Task [Blob]
readBlobs from = ReadBlobs from `Then` return
-- | A 'Task' which reads a list of pairs of 'Blob's from a 'Handle' or a list of pairs of 'FilePath's optionally paired with 'Language's.
readBlobPairs :: Either Handle [Both (FilePath, Maybe Language)] -> Task [Both Blob]
readBlobPairs :: Either Handle [Both (FilePath, Maybe Language)] -> Task [BlobPair]
readBlobPairs from = ReadBlobPairs from `Then` return
-- | A 'Task' which writes a 'B.ByteString' to a 'Handle' or a 'FilePath'.
@ -134,12 +138,24 @@ render renderer input = Render renderer input `Then` return
distribute :: Traversable t => t (Task output) -> Task (t output)
distribute tasks = Distribute tasks `Then` return
-- | Distribute a 'Bitraversable' container of 'Task's over the available cores (i.e. execute them concurrently), collecting their results.
--
-- This is a concurrent analogue of 'bisequenceA'.
bidistribute :: Bitraversable t => t (Task output1) (Task output2) -> Task (t output1 output2)
bidistribute tasks = Bidistribute tasks `Then` return
-- | Distribute the application of a function to each element of a 'Traversable' container of inputs over the available cores (i.e. perform the function concurrently for each element), collecting the results.
--
-- This is a concurrent analogue of 'for' or 'traverse' (with the arguments flipped).
distributeFor :: Traversable t => t a -> (a -> Task output) -> Task (t output)
distributeFor inputs toTask = distribute (fmap toTask inputs)
-- | Distribute the application of a function to each element of a 'Bitraversable' container of inputs over the available cores (i.e. perform the functions concurrently for each element), collecting the results.
--
-- This is a concurrent analogue of 'bifor' or 'bitraverse' (with the arguments flipped).
bidistributeFor :: Bitraversable t => t a b -> (a -> Task output1) -> (b -> Task output2) -> Task (t output1 output2)
bidistributeFor inputs toTask1 toTask2 = bidistribute (bimap toTask1 toTask2 inputs)
-- | Distribute the application of a function to each element of a 'Traversable' container of inputs over the available cores (i.e. perform the function concurrently for each element), combining the results 'Monoid'ally into a final value.
--
-- This is a concurrent analogue of 'foldMap'.
@ -176,11 +192,11 @@ runTaskWithOptions options task = do
run options logger statter = go
where
go :: Task a -> IO (Either SomeException a)
go = iterFreerA (\ task yield -> case task of
go = iterFreerA (\ yield task -> case task of
ReadBlobs (Left handle) -> (IO.readBlobsFromHandle handle >>= yield) `catchError` (pure . Left . toException)
ReadBlobs (Right paths@[(path, Nothing)]) -> (IO.isDirectory path >>= bool (IO.readBlobsFromPaths paths) (IO.readBlobsFromDir path) >>= yield) `catchError` (pure . Left . toException)
ReadBlobs (Right paths) -> (IO.readBlobsFromPaths paths >>= yield) `catchError` (pure . Left . toException)
ReadBlobPairs source -> (either IO.readBlobPairsFromHandle (traverse (traverse (uncurry IO.readFile))) source >>= yield) `catchError` (pure . Left . toException)
ReadBlobPairs source -> (either IO.readBlobPairsFromHandle (traverse (runBothWith IO.readFilePair)) source >>= yield) `catchError` (pure . Left . toException)
WriteToOutput destination contents -> either B.hPutStr B.writeFile destination contents >>= yield
WriteLog level message pairs -> queueLogMessage logger level message pairs >>= yield
WriteStat stat -> queue statter stat >>= yield
@ -190,6 +206,7 @@ runTaskWithOptions options task = do
Semantic.Task.Diff differ term1 term2 -> pure (differ term1 term2) >>= yield
Render renderer input -> pure (renderer input) >>= yield
Distribute tasks -> Async.mapConcurrently go tasks >>= either (pure . Left) yield . sequenceA . withStrategy (parTraversable (parTraversable rseq))
Bidistribute tasks -> Async.runConcurrently (bitraverse (Async.Concurrently . go) (Async.Concurrently . go) tasks) >>= either (pure . Left) yield . bisequenceA . withStrategy (parBitraversable (parTraversable rseq) (parTraversable rseq))
LiftIO action -> action >>= yield
Throw err -> pure (Left err)
Catch during handler -> do
@ -198,6 +215,9 @@ runTaskWithOptions options task = do
Left err -> go (handler err) >>= either (pure . Left) yield
Right a -> yield a) . fmap Right
parBitraversable :: Bitraversable t => Strategy a -> Strategy b -> Strategy (t a b)
parBitraversable strat1 strat2 = bitraverse (rparWith strat1) (rparWith strat2)
runParser :: Options -> Blob -> Parser term -> Task term
runParser Options{..} blob@Blob{..} = go
where
@ -227,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
@ -238,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

View File

@ -5,10 +5,11 @@ module Semantic.Util where
import Analysis.Declaration
import Control.Monad.IO.Class
import Data.Align.Generic
import Data.Maybe
import Data.Blob
import Data.Diff
import Data.Functor.Both
import Data.Functor.Classes
import Data.Bifunctor.Join
import Data.Range
import Data.Record
import Data.Span
@ -21,7 +22,7 @@ import Semantic.IO as IO
import Semantic.Task
file :: MonadIO m => FilePath -> m Blob
file path = IO.readFile path (languageForFilePath path)
file path = IO.readFile path (languageForFilePath path) >>= pure . fromJust
diffWithParser :: (HasField fields Data.Span.Span,
HasField fields Range,
@ -29,12 +30,13 @@ diffWithParser :: (HasField fields Data.Span.Span,
Traversable syntax, Functor syntax,
Foldable syntax, Diffable syntax,
GAlign syntax, HasDeclaration syntax)
=> Parser (Term syntax (Record fields))
-> Both Blob
=>
Parser (Term syntax (Record fields))
-> BlobPair
-> Task (Diff syntax (Record (Maybe Declaration ': fields)) (Record (Maybe Declaration ': fields)))
diffWithParser parser = run (\ blob -> parse parser blob >>= decorate (declarationAlgebra blob))
where
run parse sourceBlobs = distributeFor sourceBlobs parse >>= runBothWith (diffTermPair sourceBlobs diffTerms)
run parse blobs = bidistributeFor (runJoin blobs) parse parse >>= diffTermPair diffTerms
diffBlobWithParser :: (HasField fields Data.Span.Span,
HasField fields Range,

View File

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

View File

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

View File

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

View File

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

View File

@ -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 arent 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 (Both Blob)
blobsForPaths = traverse (readFile . ("test/fixtures/toc/" <>))
sourceSpanBetween :: (Int, Int) -> (Int, Int) -> Span
sourceSpanBetween (s1, e1) (s2, e2) = Span (Pos s1 e1) (Pos s2 e2)
blobsForPaths :: Both FilePath -> IO BlobPair
blobsForPaths = readFilePair . fmap ("test/fixtures/toc/" <>)
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 "[]") nullOid "a.js" (Just defaultPlainBlob) (Just TypeScript)) (Blob (fromText "[a]") nullOid "b.js" (Just defaultPlainBlob) (Just TypeScript))
blankDiffBlobs = both (Blob (fromText "[]") "a.js" (Just TypeScript)) (Blob (fromText "[a]") "b.js" (Just TypeScript))

View File

@ -38,7 +38,6 @@ parseFixtures =
, (SomeRenderer JSONTermRenderer, pathMode, jsonParseTreeOutput)
, (SomeRenderer JSONTermRenderer, pathMode', jsonParseTreeOutput')
, (SomeRenderer JSONTermRenderer, Right [], emptyJsonParseTreeOutput)
, (SomeRenderer JSONTermRenderer, Right [("not-a-file.rb", Just Ruby)], emptyJsonParseTreeOutput)
, (SomeRenderer ToCTermRenderer, Right [("test/fixtures/ruby/method-declaration.A.rb", Just Ruby)], tocOutput)
]
where pathMode = Right [("test/fixtures/ruby/and-or.A.rb", Just Ruby)]
@ -55,10 +54,10 @@ 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)]
jsonOutput = "{\"diff\":{\"merge\":{\"after\":{\"category\":\"Program\",\"sourceRange\":[0,21],\"sourceSpan\":{\"start\":[1,1],\"end\":[4,1]}},\"children\":[{\"merge\":{\"after\":{\"category\":\"Method\",\"sourceRange\":[0,20],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,4]}},\"children\":[{\"merge\":{\"after\":{\"category\":\"Empty\",\"sourceRange\":[0,0],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,1]}},\"children\":[],\"before\":{\"category\":\"Empty\",\"sourceRange\":[0,0],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,1]}}}},{\"patch\":{\"replace\":[{\"category\":\"Identifier\",\"children\":[],\"name\":\"foo\",\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}},{\"category\":\"Identifier\",\"children\":[],\"name\":\"bar\",\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}}]}},{\"patch\":{\"insert\":{\"category\":\"Identifier\",\"children\":[],\"name\":\"a\",\"sourceRange\":[8,9],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,10]}}}},{\"merge\":{\"after\":{\"category\":\"\",\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}},\"children\":[{\"patch\":{\"insert\":{\"category\":\"Identifier\",\"children\":[],\"name\":\"baz\",\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}}}}],\"before\":{\"category\":\"[]\",\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,4]}}}}],\"before\":{\"category\":\"Method\",\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}}}}],\"before\":{\"category\":\"Program\",\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}}}},\"oids\":[\"0000000000000000000000000000000000000000\",\"0000000000000000000000000000000000000000\"],\"paths\":[\"test/fixtures/ruby/method-declaration.A.rb\",\"test/fixtures/ruby/method-declaration.B.rb\"]}\n"
jsonOutput = "{\"diff\":{\"merge\":{\"after\":{\"category\":\"Program\",\"sourceRange\":[0,21],\"sourceSpan\":{\"start\":[1,1],\"end\":[4,1]}},\"children\":[{\"merge\":{\"after\":{\"category\":\"Method\",\"sourceRange\":[0,20],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,4]}},\"children\":[{\"merge\":{\"after\":{\"category\":\"Empty\",\"sourceRange\":[0,0],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,1]}},\"children\":[],\"before\":{\"category\":\"Empty\",\"sourceRange\":[0,0],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,1]}}}},{\"patch\":{\"replace\":[{\"category\":\"Identifier\",\"children\":[],\"name\":\"foo\",\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}},{\"category\":\"Identifier\",\"children\":[],\"name\":\"bar\",\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}}]}},{\"patch\":{\"insert\":{\"category\":\"Identifier\",\"children\":[],\"name\":\"a\",\"sourceRange\":[8,9],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,10]}}}},{\"merge\":{\"after\":{\"category\":\"\",\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}},\"children\":[{\"patch\":{\"insert\":{\"category\":\"Identifier\",\"children\":[],\"name\":\"baz\",\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}}}}],\"before\":{\"category\":\"[]\",\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,4]}}}}],\"before\":{\"category\":\"Method\",\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}}}}],\"before\":{\"category\":\"Program\",\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}}}},\"paths\":[\"test/fixtures/ruby/method-declaration.A.rb\",\"test/fixtures/ruby/method-declaration.B.rb\"]}\n"
sExpressionOutput = "(Program\n (Method\n (Empty)\n { (Identifier)\n ->(Identifier) }\n {+(Identifier)+}\n (\n {+(Identifier)+})))\n"
tocOutput = "{\"changes\":{\"test/fixtures/ruby/method-declaration.A.rb -> test/fixtures/ruby/method-declaration.B.rb\":[{\"span\":{\"start\":[1,1],\"end\":[3,4]},\"category\":\"Method\",\"term\":\"bar\",\"changeType\":\"modified\"}]},\"errors\":{}}\n"

View File

@ -9,53 +9,52 @@ import Prelude hiding (readFile)
import Semantic.IO
import System.Exit (ExitCode(..))
import System.IO (IOMode(..), openFile)
import Test.Hspec hiding (shouldBe, shouldNotBe, shouldThrow, errorCall)
import Test.Hspec hiding (shouldBe, shouldNotBe, shouldThrow, errorCall, anyIOException)
import Test.Hspec.Expectations.Pretty
spec :: Spec
spec = parallel $ do
describe "readFile" $ do
it "returns a blob for extant files" $ do
blob <- readFile "semantic-diff.cabal" Nothing
Just blob <- readFile "semantic-diff.cabal" Nothing
blobPath blob `shouldBe` "semantic-diff.cabal"
it "returns a nullBlob for absent files" $ do
blob <- readFile "this file should not exist" Nothing
nullBlob blob `shouldBe` True
it "throws for absent files" $ do
readFile "this file should not exist" Nothing `shouldThrow` anyIOException
describe "readBlobPairsFromHandle" $ do
let a = sourceBlob "method.rb" (Just Ruby) "def foo; end"
let b = sourceBlob "method.rb" (Just Ruby) "def bar(x); end"
it "returns blobs for valid JSON encoded diff input" $ do
blobs <- blobsFromFilePath "test/fixtures/input/diff.json"
blobs `shouldBe` [both a b]
blobs `shouldBe` [blobPairDiffing a b]
it "returns blobs when there's no before" $ do
blobs <- blobsFromFilePath "test/fixtures/input/diff-no-before.json"
blobs `shouldBe` [both (emptyBlob "method.rb") b]
blobs `shouldBe` [blobPairInserting b]
it "returns blobs when there's null before" $ do
blobs <- blobsFromFilePath "test/fixtures/input/diff-null-before.json"
blobs `shouldBe` [both (emptyBlob "method.rb") b]
blobs `shouldBe` [blobPairInserting b]
it "returns blobs when there's no after" $ do
blobs <- blobsFromFilePath "test/fixtures/input/diff-no-after.json"
blobs `shouldBe` [both a (emptyBlob "method.rb")]
blobs `shouldBe` [blobPairDeleting a]
it "returns blobs when there's null after" $ do
blobs <- blobsFromFilePath "test/fixtures/input/diff-null-after.json"
blobs `shouldBe` [both a (emptyBlob "method.rb")]
blobs `shouldBe` [blobPairDeleting a]
it "returns blobs for unsupported language" $ do
h <- openFile "test/fixtures/input/diff-unsupported-language.json" ReadMode
blobs <- readBlobPairsFromHandle h
let b' = sourceBlob "test.kt" Nothing "fun main(args: Array<String>) {\nprintln(\"hi\")\n}\n"
blobs `shouldBe` [both (emptyBlob "test.kt") b']
blobs `shouldBe` [blobPairInserting b']
it "detects language based on filepath for empty language" $ do
blobs <- blobsFromFilePath "test/fixtures/input/diff-empty-language.json"
blobs `shouldBe` [both a b]
blobs `shouldBe` [blobPairDiffing a b]
it "throws on blank input" $ do
h <- openFile "test/fixtures/input/blank.json" ReadMode
@ -65,6 +64,10 @@ spec = parallel $ do
h <- openFile "test/fixtures/input/diff-no-language.json" ReadMode
readBlobsFromHandle h `shouldThrow` (== ExitFailure 1)
it "throws if null on before and after" $ do
h <- openFile "test/fixtures/input/diff-null-both-sides.json" ReadMode
readBlobPairsFromHandle h `shouldThrow` (== ExitFailure 1)
describe "readBlobsFromHandle" $ do
it "returns blobs for valid JSON encoded parse input" $ do
h <- openFile "test/fixtures/input/parse.json" ReadMode

View File

@ -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
@ -28,13 +27,13 @@ spec = parallel $ do
output `shouldBe` "(Program\n (Method\n (Empty)\n (Identifier)\n ([])))\n"
describe "diffTermPair" $ do
it "produces an Insert when the first blob is missing" $ do
result <- runTask (diffTermPair (both (emptyBlob "/foo") (sourceBlob "/foo" Nothing "")) replacing (termIn () []) (termIn () []))
result `shouldBe` Diff (Patch (Insert (In () [])))
it "produces an Insert when the first term is missing" $ do
result <- runTask (diffTermPair replacing (That (termIn () [])))
result `shouldBe` (Diff (Patch (Insert (In () []))) :: Diff [] () ())
it "produces a Delete when the second blob is missing" $ do
result <- runTask (diffTermPair (both (sourceBlob "/foo" Nothing "") (emptyBlob "/foo")) replacing (termIn () []) (termIn () []))
result `shouldBe` Diff (Patch (Delete (In () [])))
it "produces a Delete when the second term is missing" $ do
result <- runTask (diffTermPair replacing (This (termIn () [])))
result `shouldBe` (Diff (Patch (Delete (In () []))) :: Diff [] () ())
where
methodsBlob = Blob "def foo\nend\n" "ff7bbbe9495f61d9e1e58c597502d152bab1761e" "methods.rb" (Just defaultPlainBlob) (Just Ruby)
methodsBlob = Blob "def foo\nend\n" "methods.rb" (Just Ruby)

View File

@ -2,44 +2,36 @@
module SpecHelpers
( diffFilePaths
, parseFilePath
, readFile
, readFilePair
, languageForFilePath
) where
import Control.Monad ((<=<))
import Control.Exception
import Data.Blob
import qualified Data.ByteString as B
import Data.Functor.Both
import Data.Language
import Data.Maybe (fromMaybe)
import Data.Maybe (fromMaybe, fromJust)
import Data.Source
import Prelude hiding (readFile)
import Rendering.Renderer
import Semantic
import Semantic.Task
import qualified Semantic.IO as IO
import System.FilePath
-- | Returns an s-expression formatted diff for the specified FilePath pair.
diffFilePaths :: Both FilePath -> IO B.ByteString
diffFilePaths paths = do
blobs <- traverse readFile paths
runTask (diffBlobPair SExpressionDiffRenderer blobs)
diffFilePaths paths = readFilePair paths >>= runTask . diffBlobPair SExpressionDiffRenderer
-- | Returns an s-expression parse tree for the specified FilePath.
parseFilePath :: FilePath -> IO B.ByteString
parseFilePath path = do
blob <- readFile path
runTask (parseBlob SExpressionTermRenderer blob)
parseFilePath path = IO.readFile path (languageForFilePath path) >>= pure . fromJust >>= runTask . parseBlob SExpressionTermRenderer
-- | Read a file to a Blob.
--
-- NB: This is intentionally duplicated from Command.Files because eventually
-- we want to be able to test a core Semantic library that has no knowledge of
-- the filesystem or Git. The tests, however, will still leverage reading files.
readFile :: FilePath -> IO Blob
readFile path = do
source <- (Just . fromBytes <$> B.readFile path) `catch` (const (pure Nothing) :: IOException -> IO (Maybe Source))
pure $ fromMaybe (emptyBlob path) (sourceBlob path (languageForFilePath path) <$> source)
-- | Read two files to a BlobPair.
readFilePair :: Both FilePath -> IO BlobPair
readFilePair paths = let paths' = fmap (\p -> (p, languageForFilePath p)) paths in
runBothWith IO.readFilePair paths'
-- | Returns a Maybe Language based on the FilePath's extension.
languageForFilePath :: FilePath -> Maybe Language

View File

@ -1,16 +1,16 @@
package main
func main() {
h = 1
f, g += 2, 3
e *= 3
d += 1
c <<= 1
b >>= 2
a /= 2
z ^= 2
y %= 2
x &^= 2
l = 1
m, n += 2, 3
o *= 3
p += 1
q <<= 1
s >>= 2
t /= 2
u ^= 2
v %= 2
w &^= 2
var pointer *Point2D = &Point2D{x: 1000}
}

View File

@ -25,13 +25,11 @@
(
(Integer)
(Integer))))
(Assignment
{ (Identifier)
->(Identifier) }
(Times
{ (Identifier)
->(Identifier) }
(Integer)))
{+(Assignment
{+(Identifier)+}
{+(Times
{+(Identifier)+}
{+(Integer)+})+})+}
{+(Assignment
{+(Identifier)+}
{+(Plus
@ -47,24 +45,16 @@
{+(RShift
{+(Identifier)+}
{+(Integer)+})+})+}
(Assignment
{ (Identifier)
->(Identifier) }
{ (Plus
{-(Identifier)-}
{-(Integer)-})
->(DividedBy
{+(Assignment
{+(Identifier)+}
{+(DividedBy
{+(Identifier)+}
{+(Integer)+}) })
(Assignment
{ (Identifier)
->(Identifier) }
{ (LShift
{-(Identifier)-}
{-(Integer)-})
->(BXOr
{+(Integer)+})+})+}
{+(Assignment
{+(Identifier)+}
{+(BXOr
{+(Identifier)+}
{+(Integer)+}) })
{+(Integer)+})+})+}
{+(Assignment
{+(Identifier)+}
{+(Modulo
@ -88,6 +78,21 @@
{+(KeyValue
{+(Identifier)+}
{+(Integer)+})+})+})+})+})+})+}
{-(Assignment
{-(Identifier)-}
{-(Times
{-(Identifier)-}
{-(Integer)-})-})-}
{-(Assignment
{-(Identifier)-}
{-(Plus
{-(Identifier)-}
{-(Integer)-})-})-}
{-(Assignment
{-(Identifier)-}
{-(LShift
{-(Identifier)-}
{-(Integer)-})-})-}
{-(Assignment
{-(Identifier)-}
{-(RShift

View File

@ -25,13 +25,11 @@
(
(Integer)
(Integer))))
(Assignment
{ (Identifier)
->(Identifier) }
(Times
{ (Identifier)
->(Identifier) }
(Integer)))
{+(Assignment
{+(Identifier)+}
{+(Times
{+(Identifier)+}
{+(Integer)+})+})+}
{+(Assignment
{+(Identifier)+}
{+(Plus
@ -57,11 +55,15 @@
{+(BXOr
{+(Identifier)+}
{+(Integer)+})+})+}
{+(Assignment
{+(Identifier)+}
{+(Modulo
(Assignment
{ (Identifier)
->(Identifier) }
{ (Times
{-(Identifier)-}
{-(Integer)-})
->(Modulo
{+(Identifier)+}
{+(Integer)+})+})+}
{+(Integer)+}) })
{+(Assignment
{+(Identifier)+}
{+(Not

View File

@ -4,4 +4,5 @@ func main() {
x(b, c...)
y(b, c,)
z(b,c...,)
a()
}

View File

@ -9,20 +9,27 @@
(Call
{ (Identifier)
->(Identifier) }
(Identifier)
(Variadic
(
(Identifier)
(Variadic
(Identifier)))
(Empty))
(Call
{ (Identifier)
->(Identifier) }
(
(Identifier)
(Identifier))
(Empty))
(Call
{ (Identifier)
->(Identifier) }
(Identifier)
(Identifier)
(
(Identifier)
(Variadic
(Identifier)))
(Empty))
(Call
{ (Identifier)
->(Identifier) }
(Identifier)
(Variadic
(Identifier))
(Empty)))))
{-(Call
{-(Identifier)-}
{-([])-}
{-(Empty)-})-})))

View File

@ -9,20 +9,27 @@
(Call
{ (Identifier)
->(Identifier) }
(Identifier)
(Variadic
(
(Identifier)
(Variadic
(Identifier)))
(Empty))
(Call
{ (Identifier)
->(Identifier) }
(
(Identifier)
(Identifier))
(Empty))
(Call
{ (Identifier)
->(Identifier) }
(Identifier)
(Identifier)
(
(Identifier)
(Variadic
(Identifier)))
(Empty))
(Call
{ (Identifier)
->(Identifier) }
(Identifier)
(Variadic
(Identifier))
(Empty)))))
{+(Call
{+(Identifier)+}
{+([])+}
{+(Empty)+})+})))

View File

@ -8,18 +8,25 @@
(
(Call
(Identifier)
(
(Identifier)
(Variadic
(Identifier)))
(Empty))
(Call
(Identifier)
(Variadic
(
(Identifier)
(Identifier))
(Empty))
(Call
(Identifier)
(Identifier)
(Identifier)
(
(Identifier)
(Variadic
(Identifier)))
(Empty))
(Call
(Identifier)
(Identifier)
(Variadic
(Identifier))
([])
(Empty)))))

View File

@ -8,18 +8,21 @@
(
(Call
(Identifier)
(
(Identifier)
(Variadic
(Identifier)))
(Empty))
(Call
(Identifier)
(Variadic
(
(Identifier)
(Identifier))
(Empty))
(Call
(Identifier)
(Identifier)
(Identifier)
(Empty))
(Call
(Identifier)
(Identifier)
(Variadic
(Identifier))
(
(Identifier)
(Variadic
(Identifier)))
(Empty)))))

View File

@ -15,6 +15,7 @@
{+(Identifier)+}
{+(Call
{+(Identifier)+}
{+([])+}
{+(Empty)+})+})+})+}
{+(Match
{+(
@ -27,9 +28,11 @@
{+(
{+(Call
{+(Identifier)+}
{+([])+}
{+(Empty)+})+}
{+(Call
{+(Identifier)+}
{+([])+}
{+(Empty)+})+}
{+(Pattern
{+(Identifier)+}
@ -38,6 +41,7 @@
{+(
{+(Call
{+(Identifier)+}
{+([])+}
{+(Empty)+})+}
{+(Break
{+(Empty)+})+})+})+})+})+}) }))

View File

@ -12,6 +12,7 @@
{-(Identifier)-}
{-(Call
{-(Identifier)-}
{-([])-}
{-(Empty)-})-})-})-}
{-(Match
{-(
@ -24,9 +25,11 @@
{-(
{-(Call
{-(Identifier)-}
{-([])-}
{-(Empty)-})-}
{-(Call
{-(Identifier)-}
{-([])-}
{-(Empty)-})-}
{-(Pattern
{-(Identifier)-}
@ -35,6 +38,7 @@
{-(
{-(Call
{-(Identifier)-}
{-([])-}
{-(Empty)-})-}
{-(Break
{-(Empty)-})-})-})-})-})-})

View File

@ -12,6 +12,7 @@
(Identifier)
(Call
(Identifier)
([])
(Empty))))
(Match
(
@ -24,9 +25,11 @@
(
(Call
(Identifier)
([])
(Empty))
(Call
(Identifier)
([])
(Empty))
(Pattern
(Identifier)
@ -35,6 +38,7 @@
(
(Call
(Identifier)
([])
(Empty))
(Break
(Empty)))))))))

View File

@ -19,7 +19,8 @@
(SendChannel
(SendChannel
(Constructor
(Empty)))))
(Empty)
([])))))
(Type
{ (Identifier)
->(Identifier) }

View File

@ -19,7 +19,8 @@
(SendChannel
(SendChannel
(Constructor
(Empty)))))
(Empty)
([])))))
(Type
{ (Identifier)
->(Identifier) }

View File

@ -16,7 +16,8 @@
(SendChannel
(SendChannel
(Constructor
(Empty)))))
(Empty)
([])))))
(Type
(Identifier)
(SendChannel

View File

@ -16,7 +16,8 @@
(SendChannel
(SendChannel
(Constructor
(Empty)))))
(Empty)
([])))))
(Type
(Identifier)
(SendChannel

View File

@ -14,22 +14,24 @@
(Empty))
(Call
(Identifier)
(SendChannel
{ (Identifier)
->(Identifier) })
(Minus
(Identifier)
(Identifier))
(
(SendChannel
{ (Identifier)
->(Identifier) })
(Minus
(Identifier)
(Identifier)))
(Empty))
(Call
(Identifier)
(SendChannel
{ (Identifier)
->(Identifier) })
{ (Integer)
->(Integer) }
{ (Integer)
->(Integer) }
(
(SendChannel
{ (Identifier)
->(Identifier) })
{ (Integer)
->(Integer) }
{ (Integer)
->(Integer) })
(Empty))
(Call
(Identifier)

View File

@ -14,22 +14,24 @@
(Empty))
(Call
(Identifier)
(SendChannel
{ (Identifier)
->(Identifier) })
(Minus
(Identifier)
(Identifier))
(
(SendChannel
{ (Identifier)
->(Identifier) })
(Minus
(Identifier)
(Identifier)))
(Empty))
(Call
(Identifier)
(SendChannel
{ (Identifier)
->(Identifier) })
{ (Integer)
->(Integer) }
{ (Integer)
->(Integer) }
(
(SendChannel
{ (Identifier)
->(Identifier) })
{ (Integer)
->(Integer) }
{ (Integer)
->(Integer) })
(Empty))
(Call
(Identifier)

View File

@ -13,18 +13,20 @@
(Empty))
(Call
(Identifier)
(SendChannel
(Identifier))
(Minus
(Identifier)
(Identifier))
(
(SendChannel
(Identifier))
(Minus
(Identifier)
(Identifier)))
(Empty))
(Call
(Identifier)
(SendChannel
(Identifier))
(Integer)
(Integer)
(
(SendChannel
(Identifier))
(Integer)
(Integer))
(Empty))
(Call
(Identifier)

View File

@ -13,18 +13,20 @@
(Empty))
(Call
(Identifier)
(SendChannel
(Identifier))
(Minus
(Identifier)
(Identifier))
(
(SendChannel
(Identifier))
(Minus
(Identifier)
(Identifier)))
(Empty))
(Call
(Identifier)
(SendChannel
(Identifier))
(Integer)
(Integer)
(
(SendChannel
(Identifier))
(Integer)
(Integer))
(Empty))
(Call
(Identifier)

View File

@ -13,6 +13,7 @@
(
(Call
(Identifier)
([])
(Empty))
(Goto
(Identifier))))
@ -22,6 +23,7 @@
{+(
{+(Call
{+(Identifier)+}
{+([])+}
{+(Empty)+})+}
{+(Break
{+(Identifier)+})+})+})+}
@ -32,6 +34,7 @@
{+(
{+(Call
{+(Identifier)+}
{+([])+}
{+(Empty)+})+}
{+(Continue
{+(Identifier)+})+})+})+}
@ -53,6 +56,7 @@
(
(Call
(Identifier)
([])
(Empty))
{+(Continue
{+(Empty)+})+}
@ -76,8 +80,9 @@
{+(Identifier)+}
{+(Call
{+(Identifier)+}
{+(Identifier)+}
{+(Identifier)+}
{+(
{+(Identifier)+}
{+(Identifier)+})+}
{+(Empty)+})+})+}
{+(ForEach
{+(
@ -86,8 +91,9 @@
{+(Identifier)+}
{+(Call
{+(Identifier)+}
{+(Identifier)+}
{+(Identifier)+}
{+(
{+(Identifier)+}
{+(Identifier)+})+}
{+(Empty)+})+})+}
{+(For
{+(Empty)+}
@ -97,6 +103,7 @@
{+(Empty)+}
{+(Call
{+(Identifier)+}
{+([])+}
{+(Empty)+})+})+}
{+(ForEach
{+(Empty)+}
@ -112,6 +119,7 @@
{-(
{-(Call
{-(Identifier)-}
{-([])-}
{-(Empty)-})-}
{-(Continue
{-(Identifier)-})-})-})-}
@ -122,6 +130,7 @@
{-(
{-(Call
{-(Identifier)-}
{-([])-}
{-(Empty)-})-}
{-(Continue
{-(Empty)-})-})-})-}
@ -142,8 +151,9 @@
{-(Identifier)-}
{-(Call
{-(Identifier)-}
{-(Identifier)-}
{-(Identifier)-}
{-(
{-(Identifier)-}
{-(Identifier)-})-}
{-(Empty)-})-})-}
{-(ForEach
{-(
@ -152,8 +162,9 @@
{-(Identifier)-}
{-(Call
{-(Identifier)-}
{-(Identifier)-}
{-(Identifier)-}
{-(
{-(Identifier)-}
{-(Identifier)-})-}
{-(Empty)-})-})-}
{-(For
{-(Empty)-}
@ -163,6 +174,7 @@
{-(Empty)-}
{-(Call
{-(Identifier)-}
{-([])-}
{-(Empty)-})-})-}
{-(ForEach
{-(Empty)-}

View File

@ -13,6 +13,7 @@
(
(Call
(Identifier)
([])
(Empty))
(Goto
(Identifier))))
@ -28,6 +29,7 @@
{+(
{+(Call
{+(Identifier)+}
{+([])+}
{+(Empty)+})+}
{+(Break
{+(Identifier)+})+})+})+}
@ -41,6 +43,7 @@
{+(
{+(Call
{+(Identifier)+}
{+([])+}
{+(Empty)+})+}
{+(Continue
{+(Identifier)+})+})+})+}
@ -51,6 +54,7 @@
{+(
{+(Call
{+(Identifier)+}
{+([])+}
{+(Empty)+})+}
{+(Continue
{+(Empty)+})+})+})+}
@ -61,6 +65,7 @@
(Call
(Identifier)
{+(Identifier)+}
{-([])-}
(Empty))
(Break
{ (Identifier)
@ -72,8 +77,9 @@
{+(Identifier)+}
{+(Call
{+(Identifier)+}
{+(Identifier)+}
{+(Identifier)+}
{+(
{+(Identifier)+}
{+(Identifier)+})+}
{+(Empty)+})+})+}
{+(ForEach
{+(
@ -82,8 +88,9 @@
{+(Identifier)+}
{+(Call
{+(Identifier)+}
{+(Identifier)+}
{+(Identifier)+}
{+(
{+(Identifier)+}
{+(Identifier)+})+}
{+(Empty)+})+})+}
{+(For
{+(Empty)+}
@ -93,6 +100,7 @@
{+(Empty)+}
{+(Call
{+(Identifier)+}
{+([])+}
{+(Empty)+})+})+}
{+(ForEach
{+(Empty)+}
@ -105,6 +113,7 @@
{-(
{-(Call
{-(Identifier)-}
{-([])-}
{-(Empty)-})-}
{-(Continue
{-(Identifier)-})-})-})-}
@ -118,6 +127,7 @@
{-(
{-(Call
{-(Identifier)-}
{-([])-}
{-(Empty)-})-}
{-(Continue
{-(Empty)-})-})-})-}
@ -139,8 +149,9 @@
{-(Identifier)-}
{-(Call
{-(Identifier)-}
{-(Identifier)-}
{-(Identifier)-}
{-(
{-(Identifier)-}
{-(Identifier)-})-}
{-(Empty)-})-})-}
{-(ForEach
{-(
@ -149,8 +160,9 @@
{-(Identifier)-}
{-(Call
{-(Identifier)-}
{-(Identifier)-}
{-(Identifier)-}
{-(
{-(Identifier)-}
{-(Identifier)-})-}
{-(Empty)-})-})-}
{-(For
{-(Empty)-}
@ -160,6 +172,7 @@
{-(Empty)-}
{-(Call
{-(Identifier)-}
{-([])-}
{-(Empty)-})-})-}
{-(ForEach
{-(Empty)-}

View File

@ -13,6 +13,7 @@
(
(Call
(Identifier)
([])
(Empty))
(Goto
(Identifier))))
@ -28,6 +29,7 @@
(
(Call
(Identifier)
([])
(Empty))
(Break
(Identifier))))
@ -41,6 +43,7 @@
(
(Call
(Identifier)
([])
(Empty))
(Continue
(Identifier))))
@ -51,6 +54,7 @@
(
(Call
(Identifier)
([])
(Empty))
(Continue
(Empty))))
@ -71,8 +75,9 @@
(Identifier)
(Call
(Identifier)
(Identifier)
(Identifier)
(
(Identifier)
(Identifier))
(Empty)))
(ForEach
(
@ -81,8 +86,9 @@
(Identifier)
(Call
(Identifier)
(Identifier)
(Identifier)
(
(Identifier)
(Identifier))
(Empty)))
(For
(Empty)
@ -92,6 +98,7 @@
(Empty)
(Call
(Identifier)
([])
(Empty)))
(ForEach
(Empty)

View File

@ -13,6 +13,7 @@
(
(Call
(Identifier)
([])
(Empty))
(Goto
(Identifier))))
@ -22,6 +23,7 @@
(
(Call
(Identifier)
([])
(Empty))
(Break
(Identifier))))
@ -32,6 +34,7 @@
(
(Call
(Identifier)
([])
(Empty))
(Continue
(Identifier))))
@ -45,6 +48,7 @@
(
(Call
(Identifier)
([])
(Empty))
(Continue
(Empty))))
@ -66,8 +70,9 @@
(Identifier)
(Call
(Identifier)
(Identifier)
(Identifier)
(
(Identifier)
(Identifier))
(Empty)))
(ForEach
(
@ -76,8 +81,9 @@
(Identifier)
(Call
(Identifier)
(Identifier)
(Identifier)
(
(Identifier)
(Identifier))
(Empty)))
(For
(Empty)
@ -87,6 +93,7 @@
(Empty)
(Call
(Identifier)
([])
(Empty)))
(ForEach
(Empty)

View File

@ -13,6 +13,7 @@
->(Identifier) }
{ (Identifier)
->(Identifier) })
([])
(Empty)))
(Go
(Call
@ -21,4 +22,5 @@
->(Identifier) }
{ (Identifier)
->(Identifier) })
([])
(Empty))))))

View File

@ -13,6 +13,7 @@
->(Identifier) }
{ (Identifier)
->(Identifier) })
([])
(Empty)))
(Go
(Call
@ -21,4 +22,5 @@
->(Identifier) }
{ (Identifier)
->(Identifier) })
([])
(Empty))))))

View File

@ -11,10 +11,12 @@
(MemberAccess
(Identifier)
(Identifier))
([])
(Empty)))
(Go
(Call
(MemberAccess
(Identifier)
(Identifier))
([])
(Empty))))))

View File

@ -11,10 +11,12 @@
(MemberAccess
(Identifier)
(Identifier))
([])
(Empty)))
(Go
(Call
(MemberAccess
(Identifier)
(Identifier))
([])
(Empty))))))

View File

@ -2,14 +2,15 @@
(Module
(Identifier))
(Import
{ (TextElement)
->(TextElement) }
{ (TextElement)
->(TextElement) }
(
(Identifier)
{ (TextElement)
->(TextElement) }))
->(TextElement) }
{ (TextElement)
->(TextElement) }
(
(Identifier)
{ (TextElement)
->(TextElement) })))
(Function
(Empty)
(Identifier)

View File

@ -2,14 +2,15 @@
(Module
(Identifier))
(Import
{ (TextElement)
->(TextElement) }
{ (TextElement)
->(TextElement) }
(
(Identifier)
{ (TextElement)
->(TextElement) }))
->(TextElement) }
{ (TextElement)
->(TextElement) }
(
(Identifier)
{ (TextElement)
->(TextElement) })))
(Function
(Empty)
(Identifier)

View File

@ -2,11 +2,12 @@
(Module
(Identifier))
(Import
(TextElement)
(TextElement)
(
(Identifier)
(TextElement)))
(TextElement)
(TextElement)
(
(Identifier)
(TextElement))))
(Function
(Empty)
(Identifier)

View File

@ -2,11 +2,12 @@
(Module
(Identifier))
(Import
(TextElement)
(TextElement)
(
(Identifier)
(TextElement)))
(TextElement)
(TextElement)
(
(Identifier)
(TextElement))))
(Function
(Empty)
(Identifier)

View File

@ -11,9 +11,11 @@
(Call
{ (Identifier)
->(Identifier) }
([])
(Empty)))
(Call
(Identifier)
([])
(Empty))
(Empty))
(If
@ -23,10 +25,12 @@
->(Identifier) }
(Call
(Identifier)
([])
(Empty)))
(Identifier))
(Call
(Identifier)
([])
(Empty))
(Empty))
(If
@ -34,12 +38,15 @@
(Call
{ (Identifier)
->(Identifier) }
([])
(Empty)))
(Call
(Identifier)
([])
(Empty))
(Call
(Identifier)
([])
(Empty)))
(If
(
@ -53,6 +60,7 @@
(Call
{ (Identifier)
->(Identifier) }
([])
(Empty))
{+(Context
{+(Comment)+}
@ -65,6 +73,7 @@
(Call
{ (Identifier)
->(Identifier) }
([])
(Empty))
{ (Context
{-(Comment)-}
@ -72,11 +81,14 @@
{-(
{-(Call
{-(Identifier)-}
{-([])-}
{-(Empty)-})-})-}
{-(Call
{-(Identifier)-}
{-([])-}
{-(Empty)-})-}
{-(Empty)-})-})
->(Call
{+(Identifier)+}
{+([])+}
{+(Empty)+}) }))+}))))

View File

@ -11,9 +11,11 @@
(Call
{ (Identifier)
->(Identifier) }
([])
(Empty)))
(Call
(Identifier)
([])
(Empty))
(Empty))
(If
@ -23,10 +25,12 @@
->(Identifier) }
(Call
(Identifier)
([])
(Empty)))
(Identifier))
(Call
(Identifier)
([])
(Empty))
(Empty))
(If
@ -34,12 +38,15 @@
(Call
{ (Identifier)
->(Identifier) }
([])
(Empty)))
(Call
(Identifier)
([])
(Empty))
(Call
(Identifier)
([])
(Empty)))
(If
(
@ -53,6 +60,7 @@
(Call
{ (Identifier)
->(Identifier) }
([])
(Empty))
{-(Context
{-(Comment)-}
@ -65,9 +73,11 @@
(Call
{ (Identifier)
->(Identifier) }
([])
(Empty))
{ (Call
{-(Identifier)-}
{-([])-}
{-(Empty)-})
->(Context
{+(Comment)+}
@ -75,8 +85,10 @@
{+(
{+(Call
{+(Identifier)+}
{+([])+}
{+(Empty)+})+})+}
{+(Call
{+(Identifier)+}
{+([])+}
{+(Empty)+})+}
{+(Empty)+})+}) }))-}))))

View File

@ -10,9 +10,11 @@
(
(Call
(Identifier)
([])
(Empty)))
(Call
(Identifier)
([])
(Empty))
(Empty))
(If
@ -21,22 +23,27 @@
(Identifier)
(Call
(Identifier)
([])
(Empty)))
(Identifier))
(Call
(Identifier)
([])
(Empty))
(Empty))
(If
(
(Call
(Identifier)
([])
(Empty)))
(Call
(Identifier)
([])
(Empty))
(Call
(Identifier)
([])
(Empty)))
(If
(
@ -48,6 +55,7 @@
(Integer)))
(Call
(Identifier)
([])
(Empty))
(If
(
@ -56,6 +64,7 @@
(Integer)))
(Call
(Identifier)
([])
(Empty))
(Context
(Comment)
@ -63,8 +72,10 @@
(
(Call
(Identifier)
([])
(Empty)))
(Call
(Identifier)
([])
(Empty))
(Empty))))))))

View File

@ -10,9 +10,11 @@
(
(Call
(Identifier)
([])
(Empty)))
(Call
(Identifier)
([])
(Empty))
(Empty))
(If
@ -21,22 +23,27 @@
(Identifier)
(Call
(Identifier)
([])
(Empty)))
(Identifier))
(Call
(Identifier)
([])
(Empty))
(Empty))
(If
(
(Call
(Identifier)
([])
(Empty)))
(Call
(Identifier)
([])
(Empty))
(Call
(Identifier)
([])
(Empty)))
(If
(
@ -48,6 +55,7 @@
(Integer)))
(Call
(Identifier)
([])
(Empty))
(Context
(Comment)
@ -58,7 +66,9 @@
(Integer)))
(Call
(Identifier)
([])
(Empty))
(Call
(Identifier)
([])
(Empty))))))))

View File

@ -2,14 +2,15 @@
(Module
(Identifier))
(Import
(Context
(Comment)
(Comment)
{ (TextElement)
->(TextElement) })
(Context
(Comment)
(Empty)))
(
(Context
(Comment)
(Comment)
{ (TextElement)
->(TextElement) })
(Context
(Comment)
(Empty))))
(Function
(Empty)
(Identifier)

View File

@ -2,14 +2,15 @@
(Module
(Identifier))
(Import
(Context
(Comment)
(Comment)
{ (TextElement)
->(TextElement) })
(Context
(Comment)
(Empty)))
(
(Context
(Comment)
(Comment)
{ (TextElement)
->(TextElement) })
(Context
(Comment)
(Empty))))
(Function
(Empty)
(Identifier)

View File

@ -2,13 +2,14 @@
(Module
(Identifier))
(Import
(Context
(Comment)
(Comment)
(TextElement))
(Context
(Comment)
(Empty)))
(
(Context
(Comment)
(Comment)
(TextElement))
(Context
(Comment)
(Empty))))
(Function
(Empty)
(Identifier)

View File

@ -2,13 +2,14 @@
(Module
(Identifier))
(Import
(Context
(Comment)
(Comment)
(TextElement))
(Context
(Comment)
(Empty)))
(
(Context
(Comment)
(Comment)
(TextElement))
(Context
(Comment)
(Empty))))
(Function
(Empty)
(Identifier)

View File

@ -10,7 +10,8 @@
(Type
{ (Identifier)
->(Identifier) }
(Interface)))
(Interface
([]))))
(
(Type
{ (Identifier)
@ -24,16 +25,17 @@
{ (Identifier)
->(Identifier) }
(Interface
(Identifier)
(MemberAccess
(
(Identifier)
(Identifier))
(MethodSignature
(Identifier)
(Identifier)
(
(MemberAccess
(Identifier)
(Identifier))))))
(Identifier))
(MethodSignature
(Identifier)
(Identifier)
(
(Identifier)
(Identifier)))))))
(Context
(Comment)
(

View File

@ -10,7 +10,8 @@
(Type
{ (Identifier)
->(Identifier) }
(Interface)))
(Interface
([]))))
(
(Type
{ (Identifier)
@ -24,16 +25,17 @@
{ (Identifier)
->(Identifier) }
(Interface
(Identifier)
(MemberAccess
(
(Identifier)
(Identifier))
(MethodSignature
(Identifier)
(Identifier)
(
(MemberAccess
(Identifier)
(Identifier))))))
(Identifier))
(MethodSignature
(Identifier)
(Identifier)
(
(Identifier)
(Identifier)))))))
(Context
(Comment)
(

View File

@ -9,7 +9,8 @@
(
(Type
(Identifier)
(Interface)))
(Interface
([]))))
(
(Type
(Identifier)
@ -21,16 +22,17 @@
(Type
(Identifier)
(Interface
(Identifier)
(MemberAccess
(
(Identifier)
(Identifier))
(MethodSignature
(Identifier)
(Identifier)
(
(MemberAccess
(Identifier)
(Identifier))))))
(Identifier))
(MethodSignature
(Identifier)
(Identifier)
(
(Identifier)
(Identifier)))))))
(Context
(Comment)
(

View File

@ -9,7 +9,8 @@
(
(Type
(Identifier)
(Interface)))
(Interface
([]))))
(
(Type
(Identifier)
@ -21,16 +22,17 @@
(Type
(Identifier)
(Interface
(Identifier)
(MemberAccess
(
(Identifier)
(Identifier))
(MethodSignature
(Identifier)
(Identifier)
(
(MemberAccess
(Identifier)
(Identifier))))))
(Identifier))
(MethodSignature
(Identifier)
(Identifier)
(
(Identifier)
(Identifier)))))))
(Context
(Comment)
(

View File

@ -55,10 +55,11 @@
{+(MemberAccess
{+(Identifier)+}
{+(Identifier)+})+}
{+(MemberAccess
{+(Identifier)+}
{+(Identifier)+})+}
{+(Integer)+}
{+(
{+(MemberAccess
{+(Identifier)+}
{+(Identifier)+})+}
{+(Integer)+})+}
{+(Empty)+})+}
{+(MemberAccess
{+(Identifier)+}
@ -67,10 +68,11 @@
{+(MemberAccess
{+(Identifier)+}
{+(Identifier)+})+}
{+(MemberAccess
{+(Identifier)+}
{+(Identifier)+})+}
{+(Integer)+}
{+(
{+(MemberAccess
{+(Identifier)+}
{+(Identifier)+})+}
{+(Integer)+})+}
{+(Empty)+})+}) }
{ (Times
{-(MemberAccess

View File

@ -48,10 +48,11 @@
{-(MemberAccess
{-(Identifier)-}
{-(Identifier)-})-}
{-(MemberAccess
{-(Identifier)-}
{-(Identifier)-})-}
{-(Integer)-}
{-(
{-(MemberAccess
{-(Identifier)-}
{-(Identifier)-})-}
{-(Integer)-})-}
{-(Empty)-})-}
{-(MemberAccess
{-(Identifier)-}
@ -60,10 +61,11 @@
{-(MemberAccess
{-(Identifier)-}
{-(Identifier)-})-}
{-(MemberAccess
{-(Identifier)-}
{-(Identifier)-})-}
{-(Integer)-}
{-(
{-(MemberAccess
{-(Identifier)-}
{-(Identifier)-})-}
{-(Integer)-})-}
{-(Empty)-})-})
->(Times
{+(MemberAccess

View File

@ -44,10 +44,11 @@
(MemberAccess
(Identifier)
(Identifier))
(MemberAccess
(Identifier)
(Identifier))
(Integer)
(
(MemberAccess
(Identifier)
(Identifier))
(Integer))
(Empty))
(MemberAccess
(Identifier)
@ -56,10 +57,11 @@
(MemberAccess
(Identifier)
(Identifier))
(MemberAccess
(Identifier)
(Identifier))
(Integer)
(
(MemberAccess
(Identifier)
(Identifier))
(Integer))
(Empty)))
(MemberAccess
(Identifier)

View File

@ -14,4 +14,5 @@
->(Identifier) })
{ (Identifier)
->(Identifier) })
([])
(Empty))))

View File

@ -14,4 +14,5 @@
->(Identifier) })
{ (Identifier)
->(Identifier) })
([])
(Empty))))

View File

@ -11,4 +11,5 @@
(Identifier)
(Identifier))
(Identifier))
([])
(Empty))))

View File

@ -11,4 +11,5 @@
(Identifier)
(Identifier))
(Identifier))
([])
(Empty))))

View File

@ -13,6 +13,7 @@
([])
(Call
(Identifier)
([])
(Empty)))
(Function
(Empty)
@ -22,9 +23,11 @@
(
(Call
(Identifier)
([])
(Empty))
(Call
(Identifier)
([])
(Empty))))
(Function
(Empty)
@ -34,7 +37,9 @@
(
(Call
(Identifier)
([])
(Empty))
(Call
(Identifier)
([])
(Empty)))))

View File

@ -13,6 +13,7 @@
([])
(Call
(Identifier)
([])
(Empty)))
(Function
(Empty)
@ -22,9 +23,11 @@
(
(Call
(Identifier)
([])
(Empty))
(Call
(Identifier)
([])
(Empty))))
(Function
(Empty)
@ -34,7 +37,9 @@
(
(Call
(Identifier)
([])
(Empty))
(Call
(Identifier)
([])
(Empty)))))

View File

@ -12,6 +12,7 @@
([])
(Call
(Identifier)
([])
(Empty)))
(Function
(Empty)
@ -20,9 +21,11 @@
(
(Call
(Identifier)
([])
(Empty))
(Call
(Identifier)
([])
(Empty))))
(Function
(Empty)
@ -31,7 +34,9 @@
(
(Call
(Identifier)
([])
(Empty))
(Call
(Identifier)
([])
(Empty)))))

View File

@ -12,6 +12,7 @@
([])
(Call
(Identifier)
([])
(Empty)))
(Function
(Empty)
@ -20,9 +21,11 @@
(
(Call
(Identifier)
([])
(Empty))
(Call
(Identifier)
([])
(Empty))))
(Function
(Empty)
@ -31,7 +34,9 @@
(
(Call
(Identifier)
([])
(Empty))
(Call
(Identifier)
([])
(Empty)))))

View File

@ -11,7 +11,8 @@
{ (Identifier)
->(Identifier) }
(Constructor
(Empty))))
(Empty)
([]))))
(
(Type
{ (Identifier)
@ -38,13 +39,14 @@
->(Identifier) }
(Constructor
(Empty)
(Field
(
(MemberAccess
(Identifier)
(Identifier))))
(Field
(Identifier)
(TextElement)
(
(Identifier)))))))))
(
(Field
(
(MemberAccess
(Identifier)
(Identifier))))
(Field
(Identifier)
(TextElement)
(
(Identifier))))))))))

View File

@ -11,7 +11,8 @@
{ (Identifier)
->(Identifier) }
(Constructor
(Empty))))
(Empty)
([]))))
(
(Type
{ (Identifier)
@ -38,13 +39,14 @@
->(Identifier) }
(Constructor
(Empty)
(Field
(
(MemberAccess
(Identifier)
(Identifier))))
(Field
(Identifier)
(TextElement)
(
(Identifier)))))))))
(
(Field
(
(MemberAccess
(Identifier)
(Identifier))))
(Field
(Identifier)
(TextElement)
(
(Identifier))))))))))

View File

@ -10,7 +10,8 @@
(Type
(Identifier)
(Constructor
(Empty))))
(Empty)
([]))))
(
(Type
(Identifier)
@ -34,13 +35,14 @@
(Identifier)
(Constructor
(Empty)
(Field
(
(MemberAccess
(Identifier)
(Identifier))))
(Field
(Identifier)
(TextElement)
(
(Identifier)))))))))
(
(Field
(
(MemberAccess
(Identifier)
(Identifier))))
(Field
(Identifier)
(TextElement)
(
(Identifier))))))))))

View File

@ -10,7 +10,8 @@
(Type
(Identifier)
(Constructor
(Empty))))
(Empty)
([]))))
(
(Type
(Identifier)
@ -34,13 +35,14 @@
(Identifier)
(Constructor
(Empty)
(Field
(
(MemberAccess
(Identifier)
(Identifier))))
(Field
(Identifier)
(TextElement)
(
(Identifier)))))))))
(
(Field
(
(MemberAccess
(Identifier)
(Identifier))))
(Field
(Identifier)
(TextElement)
(
(Identifier))))))))))

View File

@ -16,6 +16,7 @@
->(Identifier) })
(Call
(Identifier)
([])
(Empty)))
(Pattern
(LessThan
@ -27,6 +28,7 @@
{-(Comment)-}
(Call
(Identifier)
([])
(Empty)))-})
{-(Context
{-(Comment)-}
@ -38,4 +40,5 @@
(Call
{ (Identifier)
->(Identifier) }
([])
(Empty))))-}))))

View File

@ -16,6 +16,7 @@
->(Identifier) })
(Call
(Identifier)
([])
(Empty)))
(Pattern
(LessThan
@ -27,6 +28,7 @@
{+(Comment)+}
(Call
(Identifier)
([])
(Empty)))+})
{+(Context
{+(Comment)+}
@ -38,4 +40,5 @@
(Call
{ (Identifier)
->(Identifier) }
([])
(Empty))))+}))))

View File

@ -14,6 +14,7 @@
(Identifier))
(Call
(Identifier)
([])
(Empty)))
(Pattern
(LessThan
@ -23,6 +24,7 @@
(Comment)
(Call
(Identifier)
([])
(Empty))))
(Context
(Comment)
@ -32,4 +34,5 @@
(Integer))
(Call
(Identifier)
([])
(Empty))))))))

View File

@ -14,6 +14,7 @@
(Identifier))
(Call
(Identifier)
([])
(Empty)))
(Pattern
(LessThan
@ -21,6 +22,7 @@
(Identifier))
(Call
(Identifier)
([])
(Empty)))
(Pattern
(Equal
@ -28,4 +30,5 @@
(Integer))
(Call
(Identifier)
([])
(Empty)))))))

View File

@ -31,22 +31,24 @@
->(Identifier) }
(Constructor
(Empty)
(Field
(Identifier)
(
(Identifier)))
(Field
(Identifier)
(
(Identifier)))
(Field
(Identifier)
(
(Identifier))))))
(
(Field
(Identifier)
(
(Identifier)))
(Field
(Identifier)
(
(Identifier)))
(Field
(Identifier)
(
(Identifier)))))))
(Type
{ (Identifier)
->(Identifier) }
(Interface))
(Interface
([])))
(Context
(Comment)
(Empty))))))

View File

@ -31,22 +31,24 @@
->(Identifier) }
(Constructor
(Empty)
(Field
(Identifier)
(
(Identifier)))
(Field
(Identifier)
(
(Identifier)))
(Field
(Identifier)
(
(Identifier))))))
(
(Field
(Identifier)
(
(Identifier)))
(Field
(Identifier)
(
(Identifier)))
(Field
(Identifier)
(
(Identifier)))))))
(Type
{ (Identifier)
->(Identifier) }
(Interface))
(Interface
([])))
(Context
(Comment)
(Empty))))))

Some files were not shown because too many files have changed in this diff Show More