mirror of
https://github.com/github/semantic.git
synced 2024-12-25 07:55:12 +03:00
Merge 'master' into json
This commit is contained in:
joshvera
parent
f7a7a2c180
commit
de2146a1cd
@ -15,10 +15,7 @@ library
|
||||
hs-source-dirs: src
|
||||
exposed-modules: Algorithm
|
||||
, Alignment
|
||||
, Arguments
|
||||
, Category
|
||||
, Command
|
||||
, Command.Files
|
||||
, Data.Align.Generic
|
||||
, Data.Blob
|
||||
, Data.Functor.Both
|
||||
@ -44,6 +41,7 @@ library
|
||||
, Data.Text.Listable
|
||||
, Decorators
|
||||
, Diff
|
||||
, Files
|
||||
, Info
|
||||
, Interpreter
|
||||
, Language
|
||||
|
||||
@ -1,40 +0,0 @@
|
||||
{-# LANGUAGE GADTs, DuplicateRecordFields, RankNTypes, StandaloneDeriving, UndecidableInstances #-}
|
||||
{-# OPTIONS_GHC -funbox-strict-fields #-}
|
||||
module Arguments where
|
||||
|
||||
import Data.Maybe
|
||||
import Language
|
||||
import Prologue
|
||||
import Renderer
|
||||
|
||||
data DiffMode = DiffStdin | DiffPaths (FilePath, Maybe Language) (FilePath, Maybe Language)
|
||||
deriving Show
|
||||
|
||||
data DiffArguments where
|
||||
DiffArguments :: (Monoid output, StringConv output ByteString) =>
|
||||
{ diffRenderer :: DiffRenderer output
|
||||
, diffMode :: DiffMode
|
||||
} -> DiffArguments
|
||||
|
||||
deriving instance Show DiffArguments
|
||||
|
||||
|
||||
data ParseMode = ParseStdin | ParsePaths [(FilePath, Maybe Language)]
|
||||
deriving Show
|
||||
|
||||
data ParseArguments where
|
||||
ParseArguments :: (Monoid output, StringConv output ByteString) =>
|
||||
{ parseTreeRenderer :: TermRenderer output
|
||||
, parseMode :: ParseMode
|
||||
} -> ParseArguments
|
||||
|
||||
deriving instance Show ParseArguments
|
||||
|
||||
|
||||
data ProgramMode = Parse ParseArguments | Diff DiffArguments
|
||||
deriving Show
|
||||
|
||||
data Arguments = Arguments
|
||||
{ programMode :: ProgramMode
|
||||
, outputFilePath :: Maybe FilePath
|
||||
} deriving Show
|
||||
@ -1,5 +0,0 @@
|
||||
module Command
|
||||
( module Files
|
||||
) where
|
||||
|
||||
import Command.Files as Files
|
||||
@ -88,6 +88,7 @@ module Data.Syntax.Assignment
|
||||
) where
|
||||
|
||||
import Control.Monad.Free.Freer
|
||||
import Data.Blob
|
||||
import Data.ByteString (isSuffixOf)
|
||||
import Data.Functor.Classes
|
||||
import Data.Functor.Foldable as F hiding (Nil)
|
||||
@ -187,14 +188,14 @@ data ErrorCause grammar
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Pretty-print an Error with reference to the source where it occurred.
|
||||
printError :: Show grammar => Source.Source -> Error grammar -> IO ()
|
||||
printError source error@Error{..} = do
|
||||
withSGRCode [SetConsoleIntensity BoldIntensity] . putStrErr $ showPos Nothing errorPos . showString ": "
|
||||
printError :: Show grammar => Blob -> Error grammar -> IO ()
|
||||
printError Blob{..} error@Error{..} = do
|
||||
withSGRCode [SetConsoleIntensity BoldIntensity] . putStrErr $ showPos (maybe Nothing (const (Just blobPath)) blobKind) errorPos . showString ": "
|
||||
withSGRCode [SetColor Foreground Vivid Red] . putStrErr $ showString "error" . showString ": " . showExpectation error . showChar '\n'
|
||||
putStrErr $ showString (toS context) . (if isSuffixOf "\n" context then identity else showChar '\n') . showString (replicate (succ (Info.posColumn errorPos + lineNumberDigits)) ' ')
|
||||
withSGRCode [SetColor Foreground Vivid Green] . putStrErr $ showChar '^' . showChar '\n'
|
||||
putStrErr $ showString (prettyCallStack callStack) . showChar '\n'
|
||||
where context = maybe "\n" (Source.sourceBytes . sconcat) (nonEmpty [ Source.fromBytes (toS (showLineNumber i)) <> Source.fromBytes ": " <> l | (i, l) <- zip [1..] (Source.sourceLines source), inRange (Info.posLine errorPos - 2, Info.posLine errorPos) i ])
|
||||
where context = maybe "\n" (Source.sourceBytes . sconcat) (nonEmpty [ Source.fromBytes (toS (showLineNumber i)) <> Source.fromBytes ": " <> l | (i, l) <- zip [1..] (Source.sourceLines blobSource), inRange (Info.posLine errorPos - 2, Info.posLine errorPos) i ])
|
||||
showLineNumber n = let s = show n in replicate (lineNumberDigits - length s) ' ' <> s
|
||||
lineNumberDigits = succ (floor (logBase 10 (fromIntegral (Info.posLine errorPos) :: Double)))
|
||||
putStrErr = hPutStr stderr . ($ "")
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, DeriveAnyClass, DuplicateRecordFields #-}
|
||||
module Command.Files
|
||||
module Files
|
||||
( readFile
|
||||
, readBlobPairsFromHandle
|
||||
, readBlobsFromHandle
|
||||
@ -20,8 +20,7 @@ import qualified Data.ByteString.Lazy as BL
|
||||
import Prelude (fail)
|
||||
import System.FilePath
|
||||
|
||||
|
||||
-- | Read a file to a Blob, transcoding to UTF-8 along the way.
|
||||
-- | Read a utf8-encoded file to a 'Blob'.
|
||||
readFile :: FilePath -> Maybe Language -> IO Blob.Blob
|
||||
readFile path language = do
|
||||
raw <- (Just <$> B.readFile path) `catch` (const (pure Nothing) :: IOException -> IO (Maybe ByteString))
|
||||
@ -19,7 +19,7 @@ data Language =
|
||||
| Python
|
||||
| Ruby
|
||||
| TypeScript
|
||||
deriving (Show, Eq, Read, Generic, ToJSON)
|
||||
deriving (Show, Eq, Read, Generic, NFData, ToJSON)
|
||||
|
||||
-- | Returns a Language based on the file extension (including the ".").
|
||||
languageForType :: String -> Maybe Language
|
||||
|
||||
@ -12,6 +12,7 @@ module Parser
|
||||
) where
|
||||
|
||||
import qualified CMark
|
||||
import Data.Blob
|
||||
import Data.Functor.Foldable hiding (fold, Nil)
|
||||
import Data.Record
|
||||
import Data.Source as Source
|
||||
@ -44,10 +45,10 @@ data Parser term where
|
||||
ASTParser :: (Bounded grammar, Enum grammar) => Ptr TS.Language -> Parser (AST grammar)
|
||||
-- | A parser producing an à la carte term given an 'AST'-producing parser and an 'Assignment' onto 'Term's in some syntax type. Assignment errors will result in a top-level 'Syntax.Error' node.
|
||||
AssignmentParser :: (Enum grammar, Eq grammar, Show grammar, Symbol grammar, Syntax.Error :< fs, Foldable (Union fs), Functor (Union fs), Recursive ast, Foldable (Base ast))
|
||||
=> Parser ast -- ^ A parser producing AST.
|
||||
-> (forall x. Base ast x -> Node grammar) -- ^ A function extracting the symbol and location.
|
||||
-> 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.
|
||||
=> Parser ast -- ^ A parser producing AST.
|
||||
-> (forall x. Base ast x -> Node grammar) -- ^ A function extracting the symbol and location.
|
||||
-> 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 :: Language -> Ptr TS.Language -> Parser (SyntaxTerm Text DefaultFields)
|
||||
-- | A parser for 'Markdown' using cmark.
|
||||
@ -79,19 +80,19 @@ jsonParser = AssignmentParser (ASTParser tree_sitter_json) headF JSON.assignment
|
||||
markdownParser :: Parser Markdown.Term
|
||||
markdownParser = AssignmentParser MarkdownParser (\ (node@Node{..} :< _) -> node { nodeSymbol = toGrammar nodeSymbol }) Markdown.assignment
|
||||
|
||||
runParser :: Parser term -> Source -> IO term
|
||||
runParser parser = case parser of
|
||||
ASTParser language -> parseToAST language
|
||||
AssignmentParser parser by assignment -> \ source -> do
|
||||
ast <- runParser parser source
|
||||
case assignBy by assignment source ast of
|
||||
runParser :: Parser term -> Blob -> IO term
|
||||
runParser parser blob@Blob{..} = case parser of
|
||||
ASTParser language -> parseToAST language blobSource
|
||||
AssignmentParser parser by assignment -> do
|
||||
ast <- runParser parser blob
|
||||
case assignBy by assignment blobSource ast of
|
||||
Left err -> do
|
||||
printError source err
|
||||
pure (errorTerm source)
|
||||
printError blob err
|
||||
pure (errorTerm blobSource)
|
||||
Right term -> pure term
|
||||
TreeSitterParser language tslanguage -> treeSitterParser language tslanguage
|
||||
MarkdownParser -> pure . cmarkParser
|
||||
LineByLineParser -> pure . lineByLineParser
|
||||
TreeSitterParser language tslanguage -> treeSitterParser language tslanguage blobSource
|
||||
MarkdownParser -> pure (cmarkParser blobSource)
|
||||
LineByLineParser -> pure (lineByLineParser blobSource)
|
||||
|
||||
errorTerm :: Syntax.Error :< fs => Source -> Term (Union fs) (Record Location)
|
||||
errorTerm source = cofree ((totalRange source :. totalSpan source :. Nil) :< inj (Syntax.Error []))
|
||||
|
||||
@ -2,6 +2,7 @@
|
||||
module Renderer
|
||||
( DiffRenderer(..)
|
||||
, TermRenderer(..)
|
||||
, SomeRenderer(..)
|
||||
, renderPatch
|
||||
, renderSExpressionDiff
|
||||
, renderSExpressionTerm
|
||||
@ -61,6 +62,14 @@ deriving instance Eq (TermRenderer output)
|
||||
deriving instance Show (TermRenderer output)
|
||||
|
||||
|
||||
-- | Abstraction of some renderer to some 'Monoid'al output which can be serialized to a 'ByteString'.
|
||||
--
|
||||
-- This type abstracts the type indices of 'DiffRenderer' and 'TermRenderer' s.t. multiple renderers can be present in a single list, alternation, etc., while retaining the ability to render and serialize. (Without 'SomeRenderer', the different output types of individual term/diff renderers prevent them from being used in a homogeneously typed setting.)
|
||||
data SomeRenderer f where
|
||||
SomeRenderer :: (Monoid output, StringConv output ByteString, Show (f output)) => f output -> SomeRenderer f
|
||||
|
||||
deriving instance Show (SomeRenderer f)
|
||||
|
||||
identifierAlgebra :: RAlgebra (CofreeF (Syntax Text) a) (Cofree (Syntax Text) a) (Maybe Identifier)
|
||||
identifierAlgebra (_ :< syntax) = case syntax of
|
||||
S.Assignment f _ -> identifier f
|
||||
|
||||
@ -81,7 +81,7 @@ data Declaration
|
||||
= MethodDeclaration { declarationIdentifier :: Text }
|
||||
| FunctionDeclaration { declarationIdentifier :: Text }
|
||||
| SectionDeclaration { declarationIdentifier :: Text, declarationLevel :: Int }
|
||||
| ErrorDeclaration { declarationIdentifier :: Text }
|
||||
| ErrorDeclaration { declarationIdentifier :: Text, declarationLanguage :: Maybe Language }
|
||||
deriving (Eq, Generic, NFData, Show)
|
||||
|
||||
getDeclaration :: HasField fields (Maybe Declaration) => Record fields -> Maybe Declaration
|
||||
@ -93,38 +93,38 @@ declaration (annotation :< _) = annotation <$ (getField annotation :: Maybe Decl
|
||||
|
||||
|
||||
-- | Compute 'Declaration's for methods and functions in 'Syntax'.
|
||||
syntaxDeclarationAlgebra :: HasField fields Range => Source -> RAlgebra (SyntaxTermF Text fields) (SyntaxTerm Text fields) (Maybe Declaration)
|
||||
syntaxDeclarationAlgebra source r = case tailF r of
|
||||
syntaxDeclarationAlgebra :: HasField fields Range => Blob -> RAlgebra (SyntaxTermF Text fields) (SyntaxTerm Text fields) (Maybe Declaration)
|
||||
syntaxDeclarationAlgebra Blob{..} r = case tailF r of
|
||||
S.Function (identifier, _) _ _ -> Just $ FunctionDeclaration (getSource identifier)
|
||||
S.Method _ (identifier, _) Nothing _ _ -> Just $ MethodDeclaration (getSource identifier)
|
||||
S.Method _ (identifier, _) (Just (receiver, _)) _ _
|
||||
| S.Indexed [receiverParams] <- unwrap receiver
|
||||
, S.ParameterDecl (Just ty) _ <- unwrap receiverParams -> Just $ MethodDeclaration ("(" <> getSource ty <> ") " <> getSource identifier)
|
||||
| otherwise -> Just $ MethodDeclaration (getSource receiver <> "." <> getSource identifier)
|
||||
S.ParseError{} -> Just $ ErrorDeclaration (toText (Source.slice (byteRange (headF r)) source))
|
||||
S.ParseError{} -> Just $ ErrorDeclaration (toText (Source.slice (byteRange (headF r)) blobSource)) blobLanguage
|
||||
_ -> Nothing
|
||||
where getSource = toText . flip Source.slice source . byteRange . extract
|
||||
where getSource = toText . flip Source.slice blobSource . byteRange . extract
|
||||
|
||||
-- | Compute 'Declaration's for methods and functions.
|
||||
declarationAlgebra :: (Declaration.Function :< fs, Declaration.Method :< fs, Syntax.Error :< fs, Functor (Union fs), HasField fields Range)
|
||||
=> Source
|
||||
=> Blob
|
||||
-> RAlgebra (TermF (Union fs) (Record fields)) (Term (Union fs) (Record fields)) (Maybe Declaration)
|
||||
declarationAlgebra source r
|
||||
declarationAlgebra Blob{..} r
|
||||
| Just (Declaration.Function (identifier, _) _ _) <- prj (tailF r) = Just $ FunctionDeclaration (getSource (extract identifier))
|
||||
| Just (Declaration.Method _ (identifier, _) _ _) <- prj (tailF r) = Just $ MethodDeclaration (getSource (extract identifier))
|
||||
| Just Syntax.Error{} <- prj (tailF r) = Just $ ErrorDeclaration (getSource (headF r))
|
||||
| Just Syntax.Error{} <- prj (tailF r) = Just $ ErrorDeclaration (getSource (headF r)) blobLanguage
|
||||
| otherwise = Nothing
|
||||
where getSource = toText . flip Source.slice source . byteRange
|
||||
where getSource = toText . flip Source.slice blobSource . byteRange
|
||||
|
||||
-- | Compute 'Declaration's with the headings of 'Markup.Section's.
|
||||
markupSectionAlgebra :: (Markup.Section :< fs, Syntax.Error :< fs, HasField fields Range, Functor (Union fs), Foldable (Union fs))
|
||||
=> Source
|
||||
=> Blob
|
||||
-> RAlgebra (TermF (Union fs) (Record fields)) (Term (Union fs) (Record fields)) (Maybe Declaration)
|
||||
markupSectionAlgebra source r
|
||||
| Just (Markup.Section level (heading, _) _) <- prj (tailF r) = Just $ SectionDeclaration (maybe (getSource (extract heading)) (firstLine . toText . flip Source.slice source . sconcat) (nonEmpty (byteRange . extract <$> toList (unwrap heading)))) level
|
||||
| Just Syntax.Error{} <- prj (tailF r) = Just $ ErrorDeclaration (getSource (headF r))
|
||||
markupSectionAlgebra Blob{..} r
|
||||
| Just (Markup.Section level (heading, _) _) <- prj (tailF r) = Just $ SectionDeclaration (maybe (getSource (extract heading)) (firstLine . toText . flip Source.slice blobSource . sconcat) (nonEmpty (byteRange . extract <$> toList (unwrap heading)))) level
|
||||
| Just Syntax.Error{} <- prj (tailF r) = Just $ ErrorDeclaration (getSource (headF r)) blobLanguage
|
||||
| otherwise = Nothing
|
||||
where getSource = firstLine . toText . flip Source.slice source . byteRange
|
||||
where getSource = firstLine . toText . flip Source.slice blobSource . byteRange
|
||||
firstLine = T.takeWhile (/= '\n')
|
||||
|
||||
|
||||
@ -172,30 +172,25 @@ dedupe = foldl' go []
|
||||
similarDeclaration = (==) `on` fmap (toLower . declarationIdentifier) . getDeclaration
|
||||
|
||||
-- | Construct a 'JSONSummary' from an 'Entry'. Returns 'Nothing' for 'Unchanged' patches.
|
||||
entrySummary :: (HasField fields (Maybe Declaration), HasField fields Span) => Maybe Language -> Entry (Record fields) -> Maybe JSONSummary
|
||||
entrySummary language entry = case entry of
|
||||
entrySummary :: (HasField fields (Maybe Declaration), HasField fields Span) => Entry (Record fields) -> Maybe JSONSummary
|
||||
entrySummary entry = case entry of
|
||||
Unchanged _ -> Nothing
|
||||
Changed a -> recordSummary language a "modified"
|
||||
Deleted a -> recordSummary language a "removed"
|
||||
Inserted a -> recordSummary language a "added"
|
||||
Replaced a -> recordSummary language a "modified"
|
||||
Changed a -> recordSummary a "modified"
|
||||
Deleted a -> recordSummary a "removed"
|
||||
Inserted a -> recordSummary a "added"
|
||||
Replaced a -> recordSummary a "modified"
|
||||
|
||||
-- | Construct a 'JSONSummary' from a node annotation and a change type label.
|
||||
recordSummary :: (HasField fields (Maybe Declaration), HasField fields Span) => Maybe Language -> Record fields -> Text -> Maybe JSONSummary
|
||||
recordSummary language record = case getDeclaration record of
|
||||
Just (ErrorDeclaration text) -> Just . const (ErrorSummary text (sourceSpan record) language)
|
||||
recordSummary :: (HasField fields (Maybe Declaration), HasField fields Span) => Record fields -> Text -> Maybe JSONSummary
|
||||
recordSummary record = case getDeclaration record of
|
||||
Just (ErrorDeclaration text language) -> Just . const (ErrorSummary text (sourceSpan record) language)
|
||||
Just declaration -> Just . JSONSummary (toCategoryName declaration) (declarationIdentifier declaration) (sourceSpan record)
|
||||
Nothing -> const Nothing
|
||||
|
||||
renderToCDiff :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Both Blob -> Diff f (Record fields) -> Summaries
|
||||
renderToCDiff blobs = uncurry Summaries . bimap toMap toMap . List.partition isValidSummary . diffTOC language
|
||||
renderToCDiff blobs = uncurry Summaries . bimap toMap toMap . List.partition isValidSummary . diffTOC
|
||||
where toMap [] = mempty
|
||||
toMap as = Map.singleton summaryKey (toJSON <$> as)
|
||||
language = case runJoin (blobLanguage <$> blobs) of
|
||||
(Nothing, Just after) -> Just after
|
||||
(Just before, Nothing) -> Just before
|
||||
(Nothing, Nothing) -> Nothing
|
||||
(Just before, Just _) -> Just before
|
||||
summaryKey = toS $ case runJoin (blobPath <$> blobs) of
|
||||
(before, after) | null before -> after
|
||||
| null after -> before
|
||||
@ -203,15 +198,15 @@ renderToCDiff blobs = uncurry Summaries . bimap toMap toMap . List.partition isV
|
||||
| otherwise -> before <> " -> " <> after
|
||||
|
||||
renderToCTerm :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Blob -> Term f (Record fields) -> Summaries
|
||||
renderToCTerm Blob{..} = uncurry Summaries . bimap toMap toMap . List.partition isValidSummary . termToC blobLanguage
|
||||
renderToCTerm Blob{..} = uncurry Summaries . bimap toMap toMap . List.partition isValidSummary . termToC
|
||||
where toMap [] = mempty
|
||||
toMap as = Map.singleton (toS blobPath) (toJSON <$> as)
|
||||
|
||||
diffTOC :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Maybe Language -> Diff f (Record fields) -> [JSONSummary]
|
||||
diffTOC language = mapMaybe (entrySummary language) . dedupe . tableOfContentsBy declaration
|
||||
diffTOC :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Diff f (Record fields) -> [JSONSummary]
|
||||
diffTOC = mapMaybe entrySummary . dedupe . tableOfContentsBy declaration
|
||||
|
||||
termToC :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Maybe Language -> Term f (Record fields) -> [JSONSummary]
|
||||
termToC language = mapMaybe (flip (recordSummary language) "unchanged") . termTableOfContentsBy declaration
|
||||
termToC :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Term f (Record fields) -> [JSONSummary]
|
||||
termToC = mapMaybe (flip recordSummary "unchanged") . termTableOfContentsBy declaration
|
||||
|
||||
-- The user-facing category name
|
||||
toCategoryName :: Declaration -> Text
|
||||
@ -219,10 +214,10 @@ toCategoryName declaration = case declaration of
|
||||
FunctionDeclaration _ -> "Function"
|
||||
MethodDeclaration _ -> "Method"
|
||||
SectionDeclaration _ l -> "Heading " <> show l
|
||||
ErrorDeclaration _ -> "ParseError"
|
||||
ErrorDeclaration{} -> "ParseError"
|
||||
|
||||
instance Listable Declaration where
|
||||
tiers
|
||||
= cons1 (MethodDeclaration . unListableText)
|
||||
\/ cons1 (FunctionDeclaration . unListableText)
|
||||
\/ cons1 (ErrorDeclaration . unListableText)
|
||||
\/ cons1 (flip ErrorDeclaration Nothing . unListableText)
|
||||
|
||||
@ -13,7 +13,6 @@ import Data.Blob
|
||||
import Data.Functor.Both as Both
|
||||
import Data.Functor.Classes (Eq1, Show1)
|
||||
import Data.Record
|
||||
import Data.Source
|
||||
import qualified Data.Syntax.Declaration as Declaration
|
||||
import Data.Union
|
||||
import Decorators
|
||||
@ -43,21 +42,21 @@ parseBlobs renderer = fmap toS . distributeFoldMap (parseBlob renderer) . filter
|
||||
-- | A task to parse a 'Blob' and render the resulting 'Term'.
|
||||
parseBlob :: TermRenderer output -> Blob -> Task output
|
||||
parseBlob renderer blob@Blob{..} = case (renderer, blobLanguage) of
|
||||
(ToCTermRenderer, Just Language.Markdown) -> parse markdownParser blobSource >>= decorate (markupSectionAlgebra blobSource) >>= render (renderToCTerm blob)
|
||||
(ToCTermRenderer, Just Language.Python) -> parse pythonParser blobSource >>= decorate (declarationAlgebra blobSource) . hoistCofree (weaken :: Union fs a -> Union (Declaration.Method ': fs) a) >>= render (renderToCTerm blob)
|
||||
(ToCTermRenderer, _) -> parse syntaxParser blobSource >>= decorate (syntaxDeclarationAlgebra blobSource) >>= render (renderToCTerm blob)
|
||||
(JSONTermRenderer, Just Language.Markdown) -> parse markdownParser blobSource >>= decorate constructorLabel >>= render (renderJSONTerm blob)
|
||||
(JSONTermRenderer, Just Language.Python) -> parse pythonParser blobSource >>= decorate constructorLabel >>= render (renderJSONTerm blob)
|
||||
(JSONTermRenderer, Just Language.JSON) -> parse jsonParser blobSource >>= decorate constructorLabel >>= render (renderJSONTerm blob)
|
||||
(JSONTermRenderer, _) -> parse syntaxParser blobSource >>= decorate identifierAlgebra >>= render (renderJSONTerm blob)
|
||||
(SExpressionTermRenderer, Just Language.Markdown) -> parse markdownParser blobSource >>= decorate constructorLabel >>= render renderSExpressionTerm . fmap keepConstructorLabel
|
||||
(SExpressionTermRenderer, Just Language.Python) -> parse pythonParser blobSource >>= decorate constructorLabel >>= render renderSExpressionTerm . fmap keepConstructorLabel
|
||||
(SExpressionTermRenderer, Just Language.JSON) -> parse jsonParser blobSource >>= decorate constructorLabel >>= render renderSExpressionTerm . fmap keepConstructorLabel
|
||||
(SExpressionTermRenderer, _) -> parse syntaxParser blobSource >>= render renderSExpressionTerm . fmap keepCategory
|
||||
(ToCTermRenderer, Just Language.Markdown) -> parse markdownParser blob >>= decorate (markupSectionAlgebra blob) >>= render (renderToCTerm blob)
|
||||
(ToCTermRenderer, Just Language.Python) -> parse pythonParser blob >>= decorate (declarationAlgebra blob) . hoistCofree (weaken :: Union fs a -> Union (Declaration.Method ': fs) a) >>= render (renderToCTerm blob)
|
||||
(ToCTermRenderer, _) -> parse syntaxParser blob >>= decorate (syntaxDeclarationAlgebra blob) >>= render (renderToCTerm blob)
|
||||
(JSONTermRenderer, Just Language.Markdown) -> parse markdownParser blob >>= decorate constructorLabel >>= render (renderJSONTerm blob)
|
||||
(JSONTermRenderer, Just Language.Python) -> parse pythonParser blob >>= decorate constructorLabel >>= render (renderJSONTerm blob)
|
||||
(JSONTermRenderer, Just Language.JSON) -> parse jsonParser blob >>= decorate constructorLabel >>= render (renderJSONTerm blob)
|
||||
(JSONTermRenderer, _) -> parse syntaxParser blob >>= decorate identifierAlgebra >>= render (renderJSONTerm blob)
|
||||
(SExpressionTermRenderer, Just Language.Markdown) -> parse markdownParser blob >>= decorate constructorLabel >>= render renderSExpressionTerm . fmap keepConstructorLabel
|
||||
(SExpressionTermRenderer, Just Language.Python) -> parse pythonParser blob >>= decorate constructorLabel >>= render renderSExpressionTerm . fmap keepConstructorLabel
|
||||
(SExpressionTermRenderer, Just Language.JSON) -> parse jsonParser blob >>= decorate constructorLabel >>= render renderSExpressionTerm . fmap keepConstructorLabel
|
||||
(SExpressionTermRenderer, _) -> parse syntaxParser blob >>= render renderSExpressionTerm . fmap keepCategory
|
||||
(IdentityTermRenderer, Just Language.Markdown) -> pure Nothing
|
||||
(IdentityTermRenderer, Just Language.Python) -> pure Nothing
|
||||
(IdentityTermRenderer, Just Language.JSON) -> pure Nothing
|
||||
(IdentityTermRenderer, _) -> Just <$> parse syntaxParser blobSource
|
||||
(IdentityTermRenderer, _) -> Just <$> parse syntaxParser blob
|
||||
where syntaxParser = parserForLanguage blobLanguage
|
||||
|
||||
|
||||
@ -68,9 +67,9 @@ diffBlobPairs renderer = fmap toS . 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 renderer blobs = case (renderer, effectiveLanguage) of
|
||||
(ToCDiffRenderer, Just Language.Markdown) -> run (\ blobSource -> parse markdownParser blobSource >>= decorate (markupSectionAlgebra blobSource)) diffLinearly (renderToCDiff blobs)
|
||||
(ToCDiffRenderer, Just Language.Python) -> run (\ blobSource -> parse pythonParser blobSource >>= decorate (declarationAlgebra blobSource) . hoistCofree (weaken :: Union fs a -> Union (Declaration.Method ': fs) a)) diffLinearly (renderToCDiff blobs)
|
||||
(ToCDiffRenderer, _) -> run (\ blobSource -> parse syntaxParser blobSource >>= decorate (syntaxDeclarationAlgebra blobSource)) diffTerms (renderToCDiff blobs)
|
||||
(ToCDiffRenderer, Just Language.Markdown) -> run (\ blob -> parse markdownParser blob >>= decorate (markupSectionAlgebra blob)) diffLinearly (renderToCDiff blobs)
|
||||
(ToCDiffRenderer, Just Language.Python) -> run (\ blob -> parse pythonParser blob >>= decorate (declarationAlgebra blob) . hoistCofree (weaken :: Union fs a -> Union (Declaration.Method ': fs) a)) diffLinearly (renderToCDiff blobs)
|
||||
(ToCDiffRenderer, _) -> run (\ blob -> parse syntaxParser blob >>= decorate (syntaxDeclarationAlgebra blob)) diffTerms (renderToCDiff blobs)
|
||||
(JSONDiffRenderer, Just Language.Markdown) -> run (parse markdownParser) diffLinearly (renderJSONDiff blobs)
|
||||
(JSONDiffRenderer, Just Language.Python) -> run (parse pythonParser) diffLinearly (renderJSONDiff blobs)
|
||||
(JSONDiffRenderer, Just Language.JSON) -> run (parse jsonParser) diffLinearly (renderJSONDiff blobs)
|
||||
@ -83,12 +82,12 @@ diffBlobPair renderer blobs = case (renderer, effectiveLanguage) of
|
||||
(SExpressionDiffRenderer, Just Language.Python) -> run (decorate constructorLabel <=< parse pythonParser) diffLinearly (renderSExpressionDiff . mapAnnotations keepConstructorLabel)
|
||||
(SExpressionDiffRenderer, Just Language.JSON) -> run (decorate constructorLabel <=< parse jsonParser) diffLinearly (renderSExpressionDiff . mapAnnotations keepConstructorLabel)
|
||||
(SExpressionDiffRenderer, _) -> run (parse syntaxParser) diffTerms (renderSExpressionDiff . mapAnnotations keepCategory)
|
||||
(IdentityDiffRenderer, _) -> run (\ blobSource -> parse syntaxParser blobSource >>= decorate (syntaxDeclarationAlgebra blobSource)) diffTerms Just
|
||||
(IdentityDiffRenderer, _) -> run (\ blob -> parse syntaxParser blob >>= decorate (syntaxDeclarationAlgebra blob)) diffTerms Just
|
||||
where effectiveLanguage = runBothWith (<|>) (blobLanguage <$> blobs)
|
||||
syntaxParser = parserForLanguage effectiveLanguage
|
||||
|
||||
run :: Functor f => (Source -> Task (Term f a)) -> (Both (Term f a) -> Diff f a) -> (Diff f a -> output) -> Task output
|
||||
run parse diff renderer = distributeFor blobs (parse . blobSource) >>= diffTermPair blobs diff >>= render renderer
|
||||
run :: Functor f => (Blob -> Task (Term f a)) -> (Both (Term f a) -> Diff f a) -> (Diff f a -> output) -> Task output
|
||||
run parse diff renderer = distributeFor blobs parse >>= diffTermPair blobs diff >>= render renderer
|
||||
|
||||
diffLinearly :: (Eq1 f, GAlign f, Show1 f, Traversable f) => Both (Term f (Record fields)) -> Diff f (Record fields)
|
||||
diffLinearly = decoratingWith constructorNameAndConstantFields (diffTermsWith linearly comparableByConstructor)
|
||||
|
||||
@ -3,6 +3,9 @@ module Semantic.Task
|
||||
( Task
|
||||
, RAlgebra
|
||||
, Differ
|
||||
, readBlobs
|
||||
, readBlobPairs
|
||||
, writeToOutput
|
||||
, parse
|
||||
, decorate
|
||||
, diff
|
||||
@ -13,20 +16,26 @@ module Semantic.Task
|
||||
, runTask
|
||||
) where
|
||||
|
||||
import qualified Files
|
||||
import Control.Parallel.Strategies
|
||||
import qualified Control.Concurrent.Async as Async
|
||||
import Control.Monad.Free.Freer
|
||||
import Data.Blob
|
||||
import qualified Data.ByteString as B
|
||||
import Data.Functor.Both as Both
|
||||
import Data.Record
|
||||
import Data.Source
|
||||
import Data.Syntax.Algebra (RAlgebra, decoratorWithAlgebra)
|
||||
import Diff
|
||||
import Language
|
||||
import Parser
|
||||
import Prologue
|
||||
import Term
|
||||
|
||||
data TaskF output where
|
||||
Parse :: Parser term -> Source -> TaskF term
|
||||
ReadBlobs :: Either Handle [(FilePath, Maybe Language)] -> TaskF [Blob]
|
||||
ReadBlobPairs :: Either Handle [Both (FilePath, Maybe Language)] -> TaskF [Both Blob]
|
||||
WriteToOutput :: Either Handle FilePath -> ByteString -> TaskF ()
|
||||
Parse :: Parser term -> Blob -> TaskF term
|
||||
Decorate :: Functor f => RAlgebra (TermF f (Record fields)) (Term f (Record fields)) field -> Term f (Record fields) -> TaskF (Term f (Record (field ': fields)))
|
||||
Diff :: Differ f a -> Both (Term f a) -> TaskF (Diff f a)
|
||||
Render :: Renderer input output -> input -> TaskF output
|
||||
@ -41,10 +50,22 @@ type Differ f a = Both (Term f a) -> Diff f a
|
||||
-- | A function to render terms or diffs.
|
||||
type Renderer i o = i -> o
|
||||
|
||||
-- | A 'Task' which reads a list of 'Blob's from a 'Handle' or a list of 'FilePath's optionally paired with 'Language's.
|
||||
readBlobs :: Either Handle [(FilePath, Maybe Language)] -> Task [Blob]
|
||||
readBlobs from = ReadBlobs from `Then` return
|
||||
|
||||
-- | A 'Task' which parses 'Source' with the given 'Parser'.
|
||||
parse :: Parser term -> Source -> Task term
|
||||
parse parser source = Parse parser source `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 from = ReadBlobPairs from `Then` return
|
||||
|
||||
-- | A 'Task' which writes a 'ByteString' to a 'Handle' or a 'FilePath'.
|
||||
writeToOutput :: Either Handle FilePath -> ByteString -> Task ()
|
||||
writeToOutput path contents = WriteToOutput path contents `Then` return
|
||||
|
||||
|
||||
-- | A 'Task' which parses a 'Blob' with the given 'Parser'.
|
||||
parse :: Parser term -> Blob -> Task term
|
||||
parse parser blob = Parse parser blob `Then` return
|
||||
|
||||
-- | A 'Task' which decorates a 'Term' with values computed using the supplied 'RAlgebra' function.
|
||||
decorate :: Functor f => RAlgebra (TermF f (Record fields)) (Term f (Record fields)) field -> Term f (Record fields) -> Task (Term f (Record (field ': fields)))
|
||||
@ -80,7 +101,10 @@ distributeFoldMap toTask inputs = fmap fold (distribute (fmap toTask inputs))
|
||||
-- | Execute a 'Task', yielding its result value in 'IO'.
|
||||
runTask :: Task a -> IO a
|
||||
runTask = iterFreerA $ \ task yield -> case task of
|
||||
Parse parser source -> runParser parser source >>= yield
|
||||
ReadBlobs source -> either Files.readBlobsFromHandle (traverse (uncurry Files.readFile)) source >>= yield
|
||||
ReadBlobPairs source -> either Files.readBlobPairsFromHandle (traverse (traverse (uncurry Files.readFile))) source >>= yield
|
||||
WriteToOutput destination contents -> either B.hPutStr B.writeFile destination contents >>= yield
|
||||
Parse parser blob -> runParser parser blob >>= yield
|
||||
Decorate algebra term -> yield (decoratorWithAlgebra algebra term)
|
||||
Diff differ terms -> yield (differ terms)
|
||||
Render renderer input -> yield (renderer input)
|
||||
|
||||
@ -1,84 +1,67 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
module SemanticCmdLine (main, runDiff, runParse) where
|
||||
module SemanticCmdLine
|
||||
( main
|
||||
-- Testing
|
||||
, runDiff
|
||||
, runParse
|
||||
) where
|
||||
|
||||
import Arguments
|
||||
import Command
|
||||
import Command.Files (languageForFilePath)
|
||||
import Files (languageForFilePath)
|
||||
import Data.Functor.Both
|
||||
import Data.List.Split (splitWhen)
|
||||
import Data.Version (showVersion)
|
||||
import Development.GitRev
|
||||
import Language
|
||||
import Options.Applicative hiding (action)
|
||||
import Prologue hiding (concurrently, fst, snd, readFile)
|
||||
import Renderer
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Paths_semantic_diff as Library (version)
|
||||
import qualified Semantic.Task as Task
|
||||
import System.Directory
|
||||
import System.FilePath.Posix (takeFileName, (-<.>))
|
||||
import System.IO (stdin)
|
||||
import qualified Semantic (parseBlobs, diffBlobPairs)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
Arguments{..} <- customExecParser (prefs showHelpOnEmpty) arguments
|
||||
outputPath <- traverse getOutputPath outputFilePath
|
||||
text <- case programMode of
|
||||
Diff args -> runDiff args
|
||||
Parse args -> runParse args
|
||||
writeToOutput outputPath text
|
||||
where
|
||||
getOutputPath path = do
|
||||
isDir <- doesDirectoryExist path
|
||||
pure $ if isDir then takeFileName path -<.> ".html" else path
|
||||
writeToOutput :: Maybe FilePath -> ByteString -> IO ()
|
||||
writeToOutput = maybe B.putStr B.writeFile
|
||||
main = customExecParser (prefs showHelpOnEmpty) arguments >>= Task.runTask
|
||||
|
||||
runDiff :: DiffArguments -> IO ByteString
|
||||
runDiff DiffArguments{..} = do
|
||||
blobs <- case diffMode of
|
||||
DiffPaths a b -> pure <$> traverse (uncurry readFile) (both a b)
|
||||
DiffStdin -> readBlobPairsFromHandle stdin
|
||||
Task.runTask (Semantic.diffBlobPairs diffRenderer blobs)
|
||||
runDiff :: SomeRenderer DiffRenderer -> Either Handle [Both (FilePath, Maybe Language)] -> Task.Task ByteString
|
||||
runDiff (SomeRenderer diffRenderer) = Semantic.diffBlobPairs diffRenderer <=< Task.readBlobPairs
|
||||
|
||||
runParse :: ParseArguments -> IO ByteString
|
||||
runParse ParseArguments{..} = do
|
||||
blobs <- case parseMode of
|
||||
ParsePaths paths -> traverse (uncurry readFile) paths
|
||||
ParseStdin -> readBlobsFromHandle stdin
|
||||
Task.runTask (Semantic.parseBlobs parseTreeRenderer blobs)
|
||||
runParse :: SomeRenderer TermRenderer -> Either Handle [(FilePath, Maybe Language)] -> Task.Task ByteString
|
||||
runParse (SomeRenderer parseTreeRenderer) = Semantic.parseBlobs parseTreeRenderer <=< Task.readBlobs
|
||||
|
||||
-- | A parser for the application's command-line arguments.
|
||||
arguments :: ParserInfo Arguments
|
||||
--
|
||||
-- Returns a 'Task' to read the input, run the requested operation, and write the output to the specified output path or stdout.
|
||||
arguments :: ParserInfo (Task.Task ())
|
||||
arguments = info (version <*> helper <*> argumentsParser) description
|
||||
where
|
||||
version = infoOption versionString (long "version" <> short 'v' <> help "Output the version of the program")
|
||||
versionString = "semantic version " <> showVersion Library.version <> " (" <> $(gitHash) <> ")"
|
||||
description = fullDesc <> header "semantic -- Parse and diff semantically"
|
||||
|
||||
argumentsParser = Arguments
|
||||
argumentsParser = (. Task.writeToOutput) . (>>=)
|
||||
<$> hsubparser (diffCommand <> parseCommand)
|
||||
<*> optional (strOption (long "output" <> short 'o' <> help "Output path, defaults to stdout"))
|
||||
<*> ( Right <$> strOption (long "output" <> short 'o' <> help "Output path, defaults to stdout")
|
||||
<|> pure (Left stdout) )
|
||||
|
||||
diffCommand = command "diff" (info diffArgumentsParser (progDesc "Show changes between commits or paths"))
|
||||
diffArgumentsParser = Diff
|
||||
<$> ( ( flag (DiffArguments PatchDiffRenderer) (DiffArguments PatchDiffRenderer) (long "patch" <> help "Output a patch(1)-compatible diff (default)")
|
||||
<|> flag' (DiffArguments JSONDiffRenderer) (long "json" <> help "Output a json diff")
|
||||
<|> flag' (DiffArguments SExpressionDiffRenderer) (long "sexpression" <> help "Output an s-expression diff tree")
|
||||
<|> flag' (DiffArguments ToCDiffRenderer) (long "toc" <> help "Output a table of contents for a diff") )
|
||||
<*> ( DiffPaths
|
||||
<$> argument filePathReader (metavar "FILE_A")
|
||||
<*> argument filePathReader (metavar "FILE_B")
|
||||
<|> pure DiffStdin ))
|
||||
diffArgumentsParser = runDiff
|
||||
<$> ( flag (SomeRenderer PatchDiffRenderer) (SomeRenderer PatchDiffRenderer) (long "patch" <> help "Output a patch(1)-compatible diff (default)")
|
||||
<|> flag' (SomeRenderer JSONDiffRenderer) (long "json" <> help "Output a json diff")
|
||||
<|> flag' (SomeRenderer SExpressionDiffRenderer) (long "sexpression" <> help "Output an s-expression diff tree")
|
||||
<|> flag' (SomeRenderer ToCDiffRenderer) (long "toc" <> help "Output a table of contents for a diff") )
|
||||
<*> ( ((Right . pure) .) . both
|
||||
<$> argument filePathReader (metavar "FILE_A")
|
||||
<*> argument filePathReader (metavar "FILE_B")
|
||||
<|> pure (Left stdin) )
|
||||
|
||||
parseCommand = command "parse" (info parseArgumentsParser (progDesc "Print parse trees for path(s)"))
|
||||
parseArgumentsParser = Parse
|
||||
<$> ( ( flag (ParseArguments SExpressionTermRenderer) (ParseArguments SExpressionTermRenderer) (long "sexpression" <> help "Output s-expression parse trees (default)")
|
||||
<|> flag' (ParseArguments JSONTermRenderer) (long "json" <> help "Output JSON parse trees")
|
||||
<|> flag' (ParseArguments ToCTermRenderer) (long "toc" <> help "Output a table of contents for a file"))
|
||||
<*> ( ParsePaths
|
||||
<$> some (argument filePathReader (metavar "FILES..."))
|
||||
<|> pure ParseStdin ))
|
||||
parseArgumentsParser = runParse
|
||||
<$> ( 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 a table of contents for a file"))
|
||||
<*> ( Right <$> some (argument filePathReader (metavar "FILES..."))
|
||||
<|> pure (Left stdin) )
|
||||
|
||||
filePathReader = eitherReader parseFilePath
|
||||
parseFilePath arg = case splitWhen (== ':') arg of
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
module CommandSpec where
|
||||
|
||||
import Command
|
||||
import Files
|
||||
import Data.Blob
|
||||
import Data.Functor.Both as Both
|
||||
import Data.Maybe
|
||||
|
||||
@ -1,10 +1,11 @@
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
module SemanticCmdLineSpec where
|
||||
|
||||
import Prologue
|
||||
import Arguments
|
||||
import Data.Functor.Both
|
||||
import Language
|
||||
import Prologue
|
||||
import Renderer
|
||||
import Semantic.Task
|
||||
import SemanticCmdLine
|
||||
import Test.Hspec hiding (shouldBe, shouldNotBe, shouldThrow, errorCall)
|
||||
import Test.Hspec.Expectations.Pretty
|
||||
@ -12,32 +13,32 @@ import Test.Hspec.Expectations.Pretty
|
||||
spec :: Spec
|
||||
spec = parallel $ do
|
||||
describe "runDiff" $
|
||||
for_ diffFixtures $ \ (arguments@DiffArguments{..}, expected) ->
|
||||
for_ diffFixtures $ \ (diffRenderer, diffMode, expected) ->
|
||||
it ("renders to " <> show diffRenderer <> " in mode " <> show diffMode) $ do
|
||||
output <- runDiff arguments
|
||||
output <- runTask $ runDiff diffRenderer diffMode
|
||||
output `shouldBe'` expected
|
||||
|
||||
describe "runParse" $
|
||||
for_ parseFixtures $ \ (arguments@ParseArguments{..}, expected) ->
|
||||
for_ parseFixtures $ \ (parseTreeRenderer, parseMode, expected) ->
|
||||
it ("renders to " <> show parseTreeRenderer <> " in mode " <> show parseMode) $ do
|
||||
output <- runParse arguments
|
||||
output <- runTask $ runParse parseTreeRenderer parseMode
|
||||
output `shouldBe'` expected
|
||||
where
|
||||
shouldBe' actual expected = do
|
||||
when (actual /= expected) $ print actual
|
||||
actual `shouldBe` expected
|
||||
|
||||
parseFixtures :: [(ParseArguments, ByteString)]
|
||||
parseFixtures :: [(SomeRenderer TermRenderer, Either Handle [(FilePath, Maybe Language)], ByteString)]
|
||||
parseFixtures =
|
||||
[ (ParseArguments SExpressionTermRenderer pathMode, sExpressionParseTreeOutput)
|
||||
, (ParseArguments JSONTermRenderer pathMode, jsonParseTreeOutput)
|
||||
, (ParseArguments JSONTermRenderer pathMode', jsonParseTreeOutput')
|
||||
, (ParseArguments JSONTermRenderer (ParsePaths []), emptyJsonParseTreeOutput)
|
||||
, (ParseArguments JSONTermRenderer (ParsePaths [("not-a-file.rb", Just Ruby)]), emptyJsonParseTreeOutput)
|
||||
, (ParseArguments ToCTermRenderer (ParsePaths [("test/fixtures/ruby/method-declaration.A.rb", Just Ruby)]), tocOutput)
|
||||
[ (SomeRenderer SExpressionTermRenderer, pathMode, sExpressionParseTreeOutput)
|
||||
, (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 = ParsePaths [("test/fixtures/ruby/and-or.A.rb", Just Ruby)]
|
||||
pathMode' = ParsePaths [("test/fixtures/ruby/and-or.A.rb", Just Ruby), ("test/fixtures/ruby/and-or.B.rb", Just Ruby)]
|
||||
where pathMode = Right [("test/fixtures/ruby/and-or.A.rb", Just Ruby)]
|
||||
pathMode' = Right [("test/fixtures/ruby/and-or.A.rb", Just Ruby), ("test/fixtures/ruby/and-or.B.rb", Just Ruby)]
|
||||
|
||||
sExpressionParseTreeOutput = "(Program\n (Binary\n (Identifier)\n (Other \"and\")\n (Identifier)))\n"
|
||||
jsonParseTreeOutput = "[{\"filePath\":\"test/fixtures/ruby/and-or.A.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"Binary\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"and\",\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]}}],\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]}}],\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]}},\"language\":\"Ruby\"}]\n"
|
||||
@ -46,19 +47,14 @@ parseFixtures =
|
||||
tocOutput = "{\"changes\":{\"test/fixtures/ruby/method-declaration.A.rb\":[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"category\":\"Method\",\"term\":\"foo\",\"changeType\":\"unchanged\"}]},\"errors\":{}}\n"
|
||||
|
||||
|
||||
data DiffFixture = DiffFixture
|
||||
{ arguments :: DiffArguments
|
||||
, expected :: ByteString
|
||||
} deriving (Show)
|
||||
|
||||
diffFixtures :: [(DiffArguments, ByteString)]
|
||||
diffFixtures :: [(SomeRenderer DiffRenderer, Either Handle [Both (FilePath, Maybe Language)], ByteString)]
|
||||
diffFixtures =
|
||||
[ (DiffArguments PatchDiffRenderer pathMode, patchOutput)
|
||||
, (DiffArguments JSONDiffRenderer pathMode, jsonOutput)
|
||||
, (DiffArguments SExpressionDiffRenderer pathMode, sExpressionOutput)
|
||||
, (DiffArguments ToCDiffRenderer pathMode, tocOutput)
|
||||
[ (SomeRenderer PatchDiffRenderer, pathMode, patchOutput)
|
||||
, (SomeRenderer JSONDiffRenderer, pathMode, jsonOutput)
|
||||
, (SomeRenderer SExpressionDiffRenderer, pathMode, sExpressionOutput)
|
||||
, (SomeRenderer ToCDiffRenderer, pathMode, tocOutput)
|
||||
]
|
||||
where pathMode = DiffPaths ("test/fixtures/ruby/method-declaration.A.rb", Just Ruby) ("test/fixtures/ruby/method-declaration.B.rb", Just Ruby)
|
||||
where pathMode = Right [both ("test/fixtures/ruby/method-declaration.A.rb", Just Ruby) ("test/fixtures/ruby/method-declaration.B.rb", Just Ruby)]
|
||||
|
||||
patchOutput = "diff --git a/test/fixtures/ruby/method-declaration.A.rb b/test/fixtures/ruby/method-declaration.B.rb\nindex 0000000000000000000000000000000000000000..0000000000000000000000000000000000000000 100644\n--- a/test/fixtures/ruby/method-declaration.A.rb\n+++ b/test/fixtures/ruby/method-declaration.B.rb\n@@ -1,3 +1,4 @@\n-def foo\n+def bar(a)\n+ baz\n end\n\n"
|
||||
|
||||
|
||||
@ -55,12 +55,12 @@ spec = parallel $ do
|
||||
|
||||
describe "diffTOC" $ do
|
||||
it "blank if there are no methods" $
|
||||
diffTOC Nothing blankDiff `shouldBe` [ ]
|
||||
diffTOC blankDiff `shouldBe` [ ]
|
||||
|
||||
it "summarizes changed methods" $ do
|
||||
sourceBlobs <- blobsForPaths (both "ruby/methods.A.rb" "ruby/methods.B.rb")
|
||||
Just diff <- runTask (diffBlobPair IdentityDiffRenderer sourceBlobs)
|
||||
diffTOC (Just Ruby) diff `shouldBe`
|
||||
diffTOC diff `shouldBe`
|
||||
[ JSONSummary "Method" "self.foo" (sourceSpanBetween (1, 1) (2, 4)) "added"
|
||||
, JSONSummary "Method" "bar" (sourceSpanBetween (4, 1) (6, 4)) "modified"
|
||||
, JSONSummary "Method" "baz" (sourceSpanBetween (4, 1) (5, 4)) "removed" ]
|
||||
@ -68,37 +68,37 @@ spec = parallel $ do
|
||||
it "dedupes changes in same parent method" $ do
|
||||
sourceBlobs <- blobsForPaths (both "javascript/duplicate-parent.A.js" "javascript/duplicate-parent.B.js")
|
||||
Just diff <- runTask (diffBlobPair IdentityDiffRenderer sourceBlobs)
|
||||
diffTOC Nothing diff `shouldBe`
|
||||
diffTOC diff `shouldBe`
|
||||
[ JSONSummary "Function" "myFunction" (sourceSpanBetween (1, 1) (6, 2)) "modified" ]
|
||||
|
||||
it "dedupes similar methods" $ do
|
||||
sourceBlobs <- blobsForPaths (both "javascript/erroneous-duplicate-method.A.js" "javascript/erroneous-duplicate-method.B.js")
|
||||
Just diff <- runTask (diffBlobPair IdentityDiffRenderer sourceBlobs)
|
||||
diffTOC (Just JavaScript) diff `shouldBe`
|
||||
diffTOC diff `shouldBe`
|
||||
[ JSONSummary "Function" "performHealthCheck" (sourceSpanBetween (8, 1) (29, 2)) "modified" ]
|
||||
|
||||
it "summarizes Go methods with receivers with special formatting" $ do
|
||||
sourceBlobs <- blobsForPaths (both "go/method-with-receiver.A.go" "go/method-with-receiver.B.go")
|
||||
Just diff <- runTask (diffBlobPair IdentityDiffRenderer sourceBlobs)
|
||||
diffTOC (Just Language.Go) diff `shouldBe`
|
||||
diffTOC diff `shouldBe`
|
||||
[ JSONSummary "Method" "(*apiClient) CheckAuth" (sourceSpanBetween (3,1) (3,101)) "added" ]
|
||||
|
||||
it "summarizes Ruby methods that start with two identifiers" $ do
|
||||
sourceBlobs <- blobsForPaths (both "ruby/method-starts-with-two-identifiers.A.rb" "ruby/method-starts-with-two-identifiers.B.rb")
|
||||
Just diff <- runTask (diffBlobPair IdentityDiffRenderer sourceBlobs)
|
||||
diffTOC (Just Ruby) diff `shouldBe`
|
||||
diffTOC diff `shouldBe`
|
||||
[ JSONSummary "Method" "foo" (sourceSpanBetween (1, 1) (4, 4)) "modified" ]
|
||||
|
||||
it "handles unicode characters in file" $ do
|
||||
sourceBlobs <- blobsForPaths (both "ruby/unicode.A.rb" "ruby/unicode.B.rb")
|
||||
Just diff <- runTask (diffBlobPair IdentityDiffRenderer sourceBlobs)
|
||||
diffTOC (Just Ruby) diff `shouldBe`
|
||||
diffTOC diff `shouldBe`
|
||||
[ JSONSummary "Method" "foo" (sourceSpanBetween (6, 1) (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")
|
||||
Just diff <- runTask (diffBlobPair IdentityDiffRenderer sourceBlobs)
|
||||
diffTOC (Just JavaScript) diff `shouldBe` []
|
||||
diffTOC diff `shouldBe` []
|
||||
|
||||
prop "inserts of methods and functions are summarized" $
|
||||
\name body ->
|
||||
@ -127,7 +127,7 @@ spec = parallel $ do
|
||||
|
||||
prop "equal terms produce identity diffs" $
|
||||
\a -> let term = defaultFeatureVectorDecorator (Info.category . headF) (unListableF a :: Term') in
|
||||
diffTOC Nothing (diffTerms (pure term)) `shouldBe` []
|
||||
diffTOC (diffTerms (pure term)) `shouldBe` []
|
||||
|
||||
describe "JSONSummary" $ do
|
||||
it "encodes modified summaries to JSON" $ do
|
||||
@ -159,7 +159,7 @@ type Diff' = SyntaxDiff Text (Maybe Declaration ': DefaultFields)
|
||||
type Term' = SyntaxTerm Text (Maybe Declaration ': DefaultFields)
|
||||
|
||||
numTocSummaries :: Diff' -> Int
|
||||
numTocSummaries diff = length $ filter isValidSummary (diffTOC Nothing diff)
|
||||
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'
|
||||
|
||||
Loading…
Reference in New Issue
Block a user