diff --git a/src/Arguments.hs b/src/Arguments.hs index eed9d979b..a963d6def 100644 --- a/src/Arguments.hs +++ b/src/Arguments.hs @@ -18,20 +18,6 @@ data DiffArguments where deriving instance Show DiffArguments -type DiffArguments' = DiffMode -> DiffArguments - -patchDiff :: DiffArguments' -patchDiff = DiffArguments PatchDiffRenderer - -jsonDiff :: DiffArguments' -jsonDiff = DiffArguments JSONDiffRenderer - -sExpressionDiff :: DiffArguments' -sExpressionDiff = DiffArguments SExpressionDiffRenderer - -tocDiff :: DiffArguments' -tocDiff = DiffArguments ToCDiffRenderer - data ParseMode = ParseStdin | ParsePaths [(FilePath, Maybe Language)] deriving Show @@ -44,13 +30,6 @@ data ParseArguments where deriving instance Show ParseArguments -type ParseArguments' = ParseMode -> ParseArguments - -sExpressionParseTree :: ParseArguments' -sExpressionParseTree = ParseArguments SExpressionTermRenderer - -jsonParseTree :: ParseArguments' -jsonParseTree = ParseArguments JSONTermRenderer data ProgramMode = Parse ParseArguments | Diff DiffArguments deriving Show diff --git a/src/Data/Align/Generic.hs b/src/Data/Align/Generic.hs index eedf195f1..2fc20f824 100644 --- a/src/Data/Align/Generic.hs +++ b/src/Data/Align/Generic.hs @@ -10,38 +10,30 @@ import Prologue -- | Functors which can be aligned (structure-unioning-ly zipped). The default implementation will operate generically over the constructors in the aligning type. class GAlign f where - galign :: f a -> f b -> Maybe (f (These a b)) - galign = galignWith identity - -- | Perform generic alignment of values of some functor, applying the given function to alignments of elements. galignWith :: (These a b -> c) -> f a -> f b -> Maybe (f c) default galignWith :: (Generic1 f, GAlign (Rep1 f)) => (These a b -> c) -> f a -> f b -> Maybe (f c) galignWith f a b = to1 <$> galignWith f (from1 a) (from1 b) +galign :: GAlign f => f a -> f b -> Maybe (f (These a b)) +galign = galignWith identity -- 'Data.Align.Align' instances instance GAlign [] where - galign = galignAlign galignWith = galignWithAlign instance GAlign Maybe where - galign = galignAlign galignWith = galignWithAlign instance GAlign Identity where galignWith f (Identity a) (Identity b) = Just (Identity (f (These a b))) instance (GAlign f, GAlign (Union fs)) => GAlign (Union (f ': fs)) where - galign u1 u2 = case (decompose u1, decompose u2) of - (Left u1', Left u2') -> weaken <$> galign u1' u2' - (Right r1, Right r2) -> inj <$> galign r1 r2 - _ -> Nothing galignWith f u1 u2 = case (decompose u1, decompose u2) of (Left u1', Left u2') -> weaken <$> galignWith f u1' u2' (Right r1, Right r2) -> inj <$> galignWith f r1 r2 _ -> Nothing instance GAlign (Union '[]) where - galign _ _ = Nothing galignWith _ _ _ = Nothing -- | Implements a function suitable for use as the definition of 'galign' for 'Align'able functors. diff --git a/src/Data/Functor/Classes/Show/Generic.hs b/src/Data/Functor/Classes/Show/Generic.hs index 6b1780f29..e194aab19 100644 --- a/src/Data/Functor/Classes/Show/Generic.hs +++ b/src/Data/Functor/Classes/Show/Generic.hs @@ -17,9 +17,9 @@ class GShow1 f where -- | showsPrec function for an application of the type constructor based on showsPrec and showList functions for the argument type. gliftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS - -- | showList function for an application of the type constructor based on showsPrec and showList functions for the argument type. The default implementation using standard list syntax is correct for most types. - gliftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS - gliftShowList sp sl = showListWith (gliftShowsPrec sp sl 0) +-- | showList function for an application of the type constructor based on showsPrec and showList functions for the argument type. The default implementation using standard list syntax is correct for most types. +gliftShowList :: GShow1 f => (Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS +gliftShowList sp sl = showListWith (gliftShowsPrec sp sl 0) -- | A suitable implementation of Show1’s liftShowsPrec for Generic1 types. genericLiftShowsPrec :: (Generic1 f, GShow1 (Rep1 f)) => (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs index 8e31200e8..154e659d9 100644 --- a/src/Data/Syntax/Assignment.hs +++ b/src/Data/Syntax/Assignment.hs @@ -75,8 +75,8 @@ module Data.Syntax.Assignment , Result(..) , Error(..) , ErrorCause(..) -, showError -, showExpectation +, printError +, withSGRCode -- Running , assign , assignBy @@ -94,7 +94,6 @@ import qualified Data.IntMap.Lazy as IntMap import Data.Ix (inRange) import Data.List.NonEmpty (nonEmpty) import Data.Record -import Data.String import GHC.Stack import qualified Info import Prologue hiding (Alt, get, Location, state) @@ -103,6 +102,7 @@ import qualified Source (Source(..), drop, slice, sourceText, actualLines) import System.Console.ANSI import Text.Parser.TreeSitter.Language import Text.Show hiding (show) +import System.IO (hIsTerminalDevice, hPutStr) -- | Assignment from an AST with some set of 'symbol's onto some other value. -- @@ -181,18 +181,28 @@ data ErrorCause grammar deriving (Eq, Show) -- | Pretty-print an Error with reference to the source where it occurred. -showError :: Show grammar => Source.Source -> Error grammar -> String -showError source error@Error{..} - = withSGRCode [SetConsoleIntensity BoldIntensity] (showSourcePos Nothing errorPos) . showString ": " . withSGRCode [SetColor Foreground Vivid Red] (showString "error") . showString ": " . showExpectation error . showChar '\n' - . showString (toS context) . (if isSuffixOf "\n" context then identity else showChar '\n') - . showString (replicate (succ (Info.column errorPos + lineNumberDigits)) ' ') . withSGRCode [SetColor Foreground Vivid Green] (showChar '^') . showChar '\n' - . showString (prettyCallStack callStack) - $ "" +printError :: Show grammar => Source.Source -> Error grammar -> IO () +printError source error@Error{..} + = do + withSGRCode [SetConsoleIntensity BoldIntensity] . putStrErr . (showSourcePos Nothing errorPos) . showString ": " $ "" + withSGRCode [SetColor Foreground Vivid Red] . putStrErr . (showString "error") . showString ": " . showExpectation error . showChar '\n' . showString (toS context) . (if isSuffixOf "\n" context then identity else showChar '\n') . showString (replicate (succ (Info.column errorPos + lineNumberDigits)) ' ') $ "" + withSGRCode [SetColor Foreground Vivid Green] . putStrErr . (showChar '^') . showChar '\n' . showString (prettyCallStack callStack) $ "" + where context = maybe "\n" (Source.sourceText . sconcat) (nonEmpty [ Source.Source (toS (showLineNumber i)) <> Source.Source ": " <> l | (i, l) <- zip [1..] (Source.actualLines source), inRange (Info.line errorPos - 2, Info.line errorPos) i ]) showLineNumber n = let s = show n in replicate (lineNumberDigits - length s) ' ' <> s lineNumberDigits = succ (floor (logBase 10 (fromIntegral (Info.line errorPos) :: Double))) - showSGRCode = showString . setSGRCode - withSGRCode code s = showSGRCode code . s . showSGRCode [] + putStrErr = hPutStr stderr + +withSGRCode :: [SGR] -> IO a -> IO () +withSGRCode code action = do + isTerm <- hIsTerminalDevice stderr + if isTerm then do + _ <- hSetSGR stderr code + _ <- action + hSetSGR stderr [] + else do + _ <- action + pure () showExpectation :: Show grammar => Error grammar -> ShowS showExpectation Error{..} = case errorCause of diff --git a/src/Parser.hs b/src/Parser.hs index 765974c47..730dd6cd8 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -26,6 +26,7 @@ import qualified Language.Ruby.Syntax as Ruby import Prologue hiding (Location) import Source import Syntax hiding (Go) +import System.IO (hPutStrLn) import System.Console.ANSI import Term import qualified Text.Parser.TreeSitter as TS @@ -81,20 +82,18 @@ runParser parser = case parser of AssignmentParser parser by assignment -> \ source -> do ast <- runParser parser source let Result err term = assignBy by assignment source ast - traverse_ (putStrLn . showError source) (toList err) + traverse_ (printError source) (toList err) case term of Just term -> do let errors = termErrors term `asTypeOf` toList err - traverse_ (putStrLn . showError source) errors - unless (Prologue.null errors) $ - putStrLn (withSGRCode [SetConsoleIntensity BoldIntensity, SetColor Foreground Vivid Red] (shows (Prologue.length errors) . showChar ' ' . showString (if Prologue.length errors == 1 then "error" else "errors")) $ "") + traverse_ (printError source) errors + unless (Prologue.null errors) $ do + withSGRCode [SetConsoleIntensity BoldIntensity, SetColor Foreground Vivid Red] . hPutStrLn stderr . (shows (Prologue.length errors) . showChar ' ' . showString (if Prologue.length errors == 1 then "error" else "errors")) $ "" pure term Nothing -> pure (errorTerm source err) TreeSitterParser language tslanguage -> treeSitterParser language tslanguage MarkdownParser -> pure . cmarkParser LineByLineParser -> lineByLineParser - where showSGRCode = showString . setSGRCode - withSGRCode code s = showSGRCode code . s . showSGRCode [] errorTerm :: Syntax.Error (Error grammar) :< fs => Source -> Maybe (Error grammar) -> Term (Union fs) (Record Location) errorTerm source err = cofree ((totalRange source :. totalSpan source :. Nil) :< inj (Syntax.Error (fromMaybe (Error (SourcePos 0 0) (UnexpectedEndOfInput [])) err))) diff --git a/src/Renderer.hs b/src/Renderer.hs index 09b58c372..10a35a672 100644 --- a/src/Renderer.hs +++ b/src/Renderer.hs @@ -7,7 +7,8 @@ module Renderer , renderSExpressionTerm , renderJSONDiff , renderJSONTerm -, renderToC +, renderToCDiff +, renderToCTerm , declarationAlgebra , markupSectionAlgebra , syntaxDeclarationAlgebra @@ -47,6 +48,8 @@ deriving instance Show (DiffRenderer output) -- | Specification of renderers for terms, producing output in the parameter type. data TermRenderer output where + -- | Compute a table of contents for the term & encode it as JSON. + ToCTermRenderer :: TermRenderer Summaries -- | Render to JSON with the format documented in docs/json-format.md under “Term.” JSONTermRenderer :: TermRenderer [Value] -- | Render to a 'ByteString' formatted as nested s-expressions. diff --git a/src/Renderer/TOC.hs b/src/Renderer/TOC.hs index 923c02659..3c20c9b7e 100644 --- a/src/Renderer/TOC.hs +++ b/src/Renderer/TOC.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses, RankNTypes, TypeOperators #-} module Renderer.TOC -( renderToC +( renderToCDiff +, renderToCTerm , diffTOC , Summaries(..) , JSONSummary(..) @@ -21,6 +22,7 @@ import Data.Align (crosswalk) import Data.Functor.Both hiding (fst, snd) import qualified Data.Functor.Both as Both import Data.Functor.Listable +import Data.List.NonEmpty (nonEmpty) import Data.Proxy import Data.Record import Data.Text (toLower) @@ -114,12 +116,12 @@ declarationAlgebra proxy source r where getSource = toText . flip Source.slice source . byteRange . extract -- | Compute 'Declaration's with the headings of 'Markup.Section's. -markupSectionAlgebra :: (Markup.Section :< fs, Syntax.Error error :< fs, HasField fields Range, Show error, Functor (Union fs)) +markupSectionAlgebra :: (Markup.Section :< fs, Syntax.Error error :< fs, HasField fields Range, Show error, Functor (Union fs), Foldable (Union fs)) => Proxy error -> Source -> RAlgebra (TermF (Union fs) (Record fields)) (Term (Union fs) (Record fields)) (Maybe Declaration) markupSectionAlgebra proxy source r - | Just (Markup.Section (heading, _) _) <- prj (tailF r) = Just $ SectionDeclaration (getSource heading) + | Just (Markup.Section (heading, _) _) <- prj (tailF r) = Just $ SectionDeclaration (maybe (getSource heading) (toText . flip Source.slice source . sconcat) (nonEmpty (byteRange . extract <$> toList (unwrap heading)))) | Just (Syntax.Error err) <- prj (tailF r) = Just $ ErrorDeclaration (show (err `asProxyTypeOf` proxy)) | otherwise = Nothing where getSource = toText . flip Source.slice source . byteRange . extract @@ -140,15 +142,21 @@ tableOfContentsBy :: Traversable f => (forall b. TermF f annotation b -> Maybe a) -- ^ A function mapping relevant nodes onto values in Maybe. -> Diff f annotation -- ^ The diff to compute the table of contents for. -> [Entry a] -- ^ A list of entries for relevant changed and unchanged nodes in the diff. -tableOfContentsBy selector = fromMaybe [] . iter diffAlgebra . fmap (Just . fmap patchEntry . crosswalk (cata termAlgebra)) +tableOfContentsBy selector = fromMaybe [] . iter diffAlgebra . fmap (Just . fmap patchEntry . crosswalk (termTableOfContentsBy selector)) where diffAlgebra r = case (selector (first Both.snd r), fold r) of (Just a, Nothing) -> Just [Unchanged a] (Just a, Just []) -> Just [Changed a] (_ , entries) -> entries - termAlgebra r | Just a <- selector r = [a] - | otherwise = fold r patchEntry = these Deleted Inserted (const Replaced) . unPatch +termTableOfContentsBy :: Traversable f + => (forall b. TermF f annotation b -> Maybe a) + -> Term f annotation + -> [a] +termTableOfContentsBy selector = cata termAlgebra + where termAlgebra r | Just a <- selector r = [a] + | otherwise = fold r + dedupe :: HasField fields (Maybe Declaration) => [Entry (Record fields)] -> [Entry (Record fields)] dedupe = foldl' go [] where go xs x | (_, _:_) <- find (exactMatch `on` entryPayload) x xs = xs @@ -170,13 +178,16 @@ entrySummary entry = case entry of Deleted a -> recordSummary a "removed" Inserted a -> recordSummary a "added" Replaced a -> recordSummary a "modified" - where recordSummary record = case getDeclaration record of - Just (ErrorDeclaration text) -> Just . const (ErrorSummary text (sourceSpan record)) - Just declaration -> Just . JSONSummary (toCategoryName declaration) (declarationIdentifier declaration) (sourceSpan record) - Nothing -> const Nothing -renderToC :: (HasField fields (Maybe Declaration), HasField fields SourceSpan, Traversable f) => Both SourceBlob -> Diff f (Record fields) -> Summaries -renderToC blobs = uncurry Summaries . bimap toMap toMap . List.partition isValidSummary . diffTOC +-- | Construct a 'JSONSummary' from a node annotation and a change type label. +recordSummary :: (HasField fields (Maybe Declaration), HasField fields SourceSpan) => Record fields -> Text -> Maybe JSONSummary +recordSummary record = case getDeclaration record of + Just (ErrorDeclaration text) -> Just . const (ErrorSummary text (sourceSpan record)) + Just declaration -> Just . JSONSummary (toCategoryName declaration) (declarationIdentifier declaration) (sourceSpan record) + Nothing -> const Nothing + +renderToCDiff :: (HasField fields (Maybe Declaration), HasField fields SourceSpan, Traversable f) => Both SourceBlob -> Diff f (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 = toS $ case runJoin (path <$> blobs) of @@ -185,9 +196,17 @@ renderToC blobs = uncurry Summaries . bimap toMap toMap . List.partition isValid | before == after -> after | otherwise -> before <> " -> " <> after +renderToCTerm :: (HasField fields (Maybe Declaration), HasField fields SourceSpan, Traversable f) => SourceBlob -> Term f (Record fields) -> Summaries +renderToCTerm blob = uncurry Summaries . bimap toMap toMap . List.partition isValidSummary . termToC + where toMap [] = mempty + toMap as = Map.singleton (toS (path blob)) (toJSON <$> as) + diffTOC :: (HasField fields (Maybe Declaration), HasField fields SourceSpan, Traversable f) => Diff f (Record fields) -> [JSONSummary] diffTOC = mapMaybe entrySummary . dedupe . tableOfContentsBy declaration +termToC :: (HasField fields (Maybe Declaration), HasField fields SourceSpan, Traversable f) => Term f (Record fields) -> [JSONSummary] +termToC = mapMaybe (flip recordSummary "unchanged") . termTableOfContentsBy declaration + -- The user-facing category name toCategoryName :: Declaration -> Text toCategoryName declaration = case declaration of diff --git a/src/Semantic.hs b/src/Semantic.hs index 0c28f10e9..9ef476ab8 100644 --- a/src/Semantic.hs +++ b/src/Semantic.hs @@ -45,6 +45,9 @@ parseBlobs renderer = fmap toS . distributeFoldMap (parseBlob renderer) . filter -- | A task to parse a 'SourceBlob' and render the resulting 'Term'. parseBlob :: TermRenderer output -> SourceBlob -> Task output parseBlob renderer blob@SourceBlob{..} = case (renderer, blobLanguage) of + (ToCTermRenderer, Just Language.Markdown) -> parse markdownParser source >>= decorate (markupSectionAlgebra (Proxy :: Proxy Markdown.Error) source) >>= render (renderToCTerm blob) + (ToCTermRenderer, Just Language.Python) -> parse pythonParser source >>= decorate (declarationAlgebra (Proxy :: Proxy Python.Error) source) . hoistCofree (weaken :: Union fs a -> Union (Declaration.Method ': fs) a) >>= render (renderToCTerm blob) + (ToCTermRenderer, _) -> parse syntaxParser source >>= decorate (syntaxDeclarationAlgebra source) >>= render (renderToCTerm blob) (JSONTermRenderer, Just Language.Markdown) -> parse markdownParser source >>= render (renderJSONTerm blob) (JSONTermRenderer, Just Language.Python) -> parse pythonParser source >>= render (renderJSONTerm blob) (JSONTermRenderer, _) -> parse syntaxParser source >>= decorate identifierAlgebra >>= render (renderJSONTerm blob) @@ -64,9 +67,9 @@ diffBlobPairs renderer = fmap toS . distributeFoldMap (diffBlobPair renderer) . -- | A task to parse a pair of 'SourceBlob's, diff them, and render the 'Diff'. diffBlobPair :: DiffRenderer output -> Both SourceBlob -> Task output diffBlobPair renderer blobs = case (renderer, effectiveLanguage) of - (ToCDiffRenderer, Just Language.Markdown) -> run (\ source -> parse markdownParser source >>= decorate (markupSectionAlgebra (Proxy :: Proxy Markdown.Error) source)) diffLinearly (renderToC blobs) - (ToCDiffRenderer, Just Language.Python) -> run (\ source -> parse pythonParser source >>= decorate (declarationAlgebra (Proxy :: Proxy Python.Error) source) . hoistCofree (weaken :: Union fs a -> Union (Declaration.Method ': fs) a)) diffLinearly (renderToC blobs) - (ToCDiffRenderer, _) -> run (\ source -> parse syntaxParser source >>= decorate (syntaxDeclarationAlgebra source)) diffTerms (renderToC blobs) + (ToCDiffRenderer, Just Language.Markdown) -> run (\ source -> parse markdownParser source >>= decorate (markupSectionAlgebra (Proxy :: Proxy Markdown.Error) source)) diffLinearly (renderToCDiff blobs) + (ToCDiffRenderer, Just Language.Python) -> run (\ source -> parse pythonParser source >>= decorate (declarationAlgebra (Proxy :: Proxy Python.Error) source) . hoistCofree (weaken :: Union fs a -> Union (Declaration.Method ': fs) a)) diffLinearly (renderToCDiff blobs) + (ToCDiffRenderer, _) -> run (\ source -> parse syntaxParser source >>= decorate (syntaxDeclarationAlgebra source)) diffTerms (renderToCDiff blobs) (JSONDiffRenderer, Just Language.Markdown) -> run (parse markdownParser) diffLinearly (renderJSONDiff blobs) (JSONDiffRenderer, Just Language.Python) -> run (parse pythonParser) diffLinearly (renderJSONDiff blobs) (JSONDiffRenderer, _) -> run (decorate identifierAlgebra <=< parse syntaxParser) diffTerms (renderJSONDiff blobs) diff --git a/src/SemanticCmdLine.hs b/src/SemanticCmdLine.hs index 4ea0ac023..d0d7b59ff 100644 --- a/src/SemanticCmdLine.hs +++ b/src/SemanticCmdLine.hs @@ -10,6 +10,7 @@ import Data.Version (showVersion) import Development.GitRev 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 @@ -61,10 +62,10 @@ arguments = info (version <*> helper <*> argumentsParser) description diffCommand = command "diff" (info diffArgumentsParser (progDesc "Show changes between commits or paths")) diffArgumentsParser = Diff - <$> ( ( flag patchDiff patchDiff (long "patch" <> help "Output a patch(1)-compatible diff (default)") - <|> flag' jsonDiff (long "json" <> help "Output a json diff") - <|> flag' sExpressionDiff (long "sexpression" <> help "Output an s-expression diff tree") - <|> flag' tocDiff (long "toc" <> help "Output a table of contents for a 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") @@ -72,8 +73,9 @@ arguments = info (version <*> helper <*> argumentsParser) description parseCommand = command "parse" (info parseArgumentsParser (progDesc "Print parse trees for path(s)")) parseArgumentsParser = Parse - <$> ( ( flag sExpressionParseTree sExpressionParseTree (long "sexpression" <> help "Output s-expression parse trees (default)") - <|> flag' jsonParseTree (long "json" <> help "Output JSON parse trees") ) + <$> ( ( 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 )) diff --git a/test/SemanticCmdLineSpec.hs b/test/SemanticCmdLineSpec.hs index 39feb451b..6991faa81 100644 --- a/test/SemanticCmdLineSpec.hs +++ b/test/SemanticCmdLineSpec.hs @@ -4,20 +4,22 @@ module SemanticCmdLineSpec where import Prologue import Arguments import Language +import Renderer import SemanticCmdLine -import Data.Functor.Listable import Test.Hspec hiding (shouldBe, shouldNotBe, shouldThrow, errorCall) import Test.Hspec.Expectations.Pretty -import Test.Hspec.LeanCheck spec :: Spec spec = parallel $ do - prop "runDiff for all modes and formats" $ - \ DiffFixture{..} -> do + describe "runDiff" $ + for_ diffFixtures $ \ (arguments@DiffArguments{..}, expected) -> + it ("renders to " <> show diffRenderer <> " in mode " <> show diffMode) $ do output <- runDiff arguments output `shouldBe'` expected - prop "runParse for all modes and formats" $ - \ ParseFixture{..} -> do + + describe "runParse" $ + for_ parseFixtures $ \ (arguments@ParseArguments{..}, expected) -> + it ("renders to " <> show parseTreeRenderer <> " in mode " <> show parseMode) $ do output <- runParse arguments output `shouldBe'` expected where @@ -25,27 +27,23 @@ spec = parallel $ do when (actual /= expected) $ print actual actual `shouldBe` expected +parseFixtures :: [(ParseArguments, 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) + ] + 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)] -data ParseFixture = ParseFixture - { arguments :: ParseArguments - , expected :: ByteString - } deriving (Show) - -instance Listable ParseFixture where - tiers = cons0 (ParseFixture (sExpressionParseTree pathMode) sExpressionParseTreeOutput) - \/ cons0 (ParseFixture (jsonParseTree pathMode) jsonParseTreeOutput) - \/ cons0 (ParseFixture (jsonParseTree pathMode') jsonParseTreeOutput') - \/ cons0 (ParseFixture (jsonParseTree (ParsePaths [])) emptyJsonParseTreeOutput) - \/ cons0 (ParseFixture (jsonParseTree (ParsePaths [("not-a-file.rb", Just Ruby)])) emptyJsonParseTreeOutput) - - 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)] - - 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" - 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\"},{\"filePath\":\"test/fixtures/ruby/and-or.B.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"Binary\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"or\",\"children\":[],\"sourceRange\":[4,6],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,7]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[7,10],\"sourceSpan\":{\"start\":[1,8],\"end\":[1,11]}}],\"sourceRange\":[0,10],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,11]}},{\"category\":\"Binary\",\"children\":[{\"category\":\"Binary\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[11,12],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,2]}},{\"category\":\"or\",\"children\":[],\"sourceRange\":[13,15],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,5]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[16,17],\"sourceSpan\":{\"start\":[2,6],\"end\":[2,7]}}],\"sourceRange\":[11,17],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,7]}},{\"category\":\"and\",\"children\":[],\"sourceRange\":[18,21],\"sourceSpan\":{\"start\":[2,8],\"end\":[2,11]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[22,23],\"sourceSpan\":{\"start\":[2,12],\"end\":[2,13]}}],\"sourceRange\":[11,23],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,13]}}],\"sourceRange\":[0,24],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},\"language\":\"Ruby\"}]\n" - emptyJsonParseTreeOutput = "[]\n" + 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" + 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\"},{\"filePath\":\"test/fixtures/ruby/and-or.B.rb\",\"programNode\":{\"category\":\"Program\",\"children\":[{\"category\":\"Binary\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},{\"category\":\"or\",\"children\":[],\"sourceRange\":[4,6],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,7]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[7,10],\"sourceSpan\":{\"start\":[1,8],\"end\":[1,11]}}],\"sourceRange\":[0,10],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,11]}},{\"category\":\"Binary\",\"children\":[{\"category\":\"Binary\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[11,12],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,2]}},{\"category\":\"or\",\"children\":[],\"sourceRange\":[13,15],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,5]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[16,17],\"sourceSpan\":{\"start\":[2,6],\"end\":[2,7]}}],\"sourceRange\":[11,17],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,7]}},{\"category\":\"and\",\"children\":[],\"sourceRange\":[18,21],\"sourceSpan\":{\"start\":[2,8],\"end\":[2,11]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[22,23],\"sourceSpan\":{\"start\":[2,12],\"end\":[2,13]}}],\"sourceRange\":[11,23],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,13]}}],\"sourceRange\":[0,24],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},\"language\":\"Ruby\"}]\n" + emptyJsonParseTreeOutput = "[]\n" + 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 @@ -53,20 +51,20 @@ data DiffFixture = DiffFixture , expected :: ByteString } deriving (Show) -instance Listable DiffFixture where - tiers = cons0 (DiffFixture (patchDiff pathMode) patchOutput) - \/ cons0 (DiffFixture (jsonDiff pathMode) jsonOutput) - \/ cons0 (DiffFixture (sExpressionDiff pathMode) sExpressionOutput) - \/ cons0 (DiffFixture (tocDiff pathMode) tocOutput) +diffFixtures :: [(DiffArguments, ByteString)] +diffFixtures = + [ (DiffArguments PatchDiffRenderer pathMode, patchOutput) + , (DiffArguments JSONDiffRenderer pathMode, jsonOutput) + , (DiffArguments SExpressionDiffRenderer pathMode, sExpressionOutput) + , (DiffArguments 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 = DiffPaths ("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" - 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" - - jsonOutput = "{\"diff\":{\"after\":{\"category\":\"Program\",\"sourceRange\":[0,21],\"sourceSpan\":{\"start\":[1,1],\"end\":[4,1]}},\"children\":[{\"after\":{\"category\":\"Method\",\"identifier\":\"bar\",\"sourceRange\":[0,20],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,4]}},\"children\":[{\"replace\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}}]},{\"insert\":{\"category\":\"Params\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[8,9],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,10]}}],\"sourceRange\":[7,13],\"sourceSpan\":{\"start\":[1,8],\"end\":[2,3]}}},{\"insert\":{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}}}],\"before\":{\"category\":\"Method\",\"identifier\":\"foo\",\"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" - sExpressionOutput = "(Program\n (Method\n { (Identifier)\n ->(Identifier) }\n {+(Params\n (Identifier))+}\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" + jsonOutput = "{\"diff\":{\"after\":{\"category\":\"Program\",\"sourceRange\":[0,21],\"sourceSpan\":{\"start\":[1,1],\"end\":[4,1]}},\"children\":[{\"after\":{\"category\":\"Method\",\"identifier\":\"bar\",\"sourceRange\":[0,20],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,4]}},\"children\":[{\"replace\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}}]},{\"insert\":{\"category\":\"Params\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[8,9],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,10]}}],\"sourceRange\":[7,13],\"sourceSpan\":{\"start\":[1,8],\"end\":[2,3]}}},{\"insert\":{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}}}],\"before\":{\"category\":\"Method\",\"identifier\":\"foo\",\"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" + sExpressionOutput = "(Program\n (Method\n { (Identifier)\n ->(Identifier) }\n {+(Params\n (Identifier))+}\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" repo :: FilePath repo = "test/fixtures/git/examples/all-languages.git"