mirror of
https://github.com/github/semantic.git
synced 2024-12-25 07:55:12 +03:00
Merge branch 'master' into ruby-assignment-a-la-carte
This commit is contained in:
commit
085839aabf
@ -1,11 +0,0 @@
|
||||
# Build configuration for https://atom.io/packages/build
|
||||
cmd: stack build
|
||||
name: semantic-diff
|
||||
env:
|
||||
PATH: ~/.local/bin:~/Developer/Tools:~/Library/Haskell/bin:/usr/local/bin:/usr/bin:/bin:/usr/sbin:/sbin
|
||||
targets:
|
||||
test:
|
||||
cmd: stack build semantic-diff:test
|
||||
keymap: cmd-u
|
||||
errorMatch:
|
||||
- \n(?<file>/[^:]+):(?<line>\d+):((?<col>\d+):)?
|
@ -1,3 +1,3 @@
|
||||
module Main (main)
|
||||
where
|
||||
import SemanticDiff (main)
|
||||
import Semantic (main)
|
||||
|
@ -1,67 +0,0 @@
|
||||
{-# LANGUAGE DeriveAnyClass, FlexibleInstances #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
module Main where
|
||||
|
||||
import Arguments
|
||||
import Criterion.Main
|
||||
import Data.Function
|
||||
import Data.List (genericLength)
|
||||
import Data.String
|
||||
import Patch
|
||||
import Prologue
|
||||
import qualified Renderer as R
|
||||
import SemanticDiff (fetchDiffs)
|
||||
import qualified SemanticDiffPar
|
||||
import SES
|
||||
import System.Directory (makeAbsolute)
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain
|
||||
[ bgroup "ses"
|
||||
[ bench "0,0" (nf (uncurry benchmarkSES) ([], []))
|
||||
, bench "1,1, =" (nf (uncurry benchmarkSES) ([lower], [lower]))
|
||||
, bench "1,1, ≠" (nf (uncurry benchmarkSES) ([lower], [upper]))
|
||||
, bench "10,10, =" (nf (uncurry benchmarkSES) (replicate 10 lower, replicate 10 lower))
|
||||
, bench "10,10, ≠" (nf (uncurry benchmarkSES) (replicate 10 lower, replicate 10 upper))
|
||||
, bench "100,100, =" (nf (uncurry benchmarkSES) (replicate 100 lower, replicate 100 lower))
|
||||
, bench "100,100, ≠" (nf (uncurry benchmarkSES) (replicate 100 lower, replicate 100 upper))
|
||||
]
|
||||
, syncAsyncBenchmark
|
||||
]
|
||||
where lower = ['a'..'z']
|
||||
upper = ['A'..'Z']
|
||||
|
||||
benchmarkSES :: [String] -> [String] -> [Either String (Patch String)]
|
||||
benchmarkSES = ses compare cost
|
||||
where compare a b = if a == b then Just (Left a) else Nothing
|
||||
cost = either (const 0) (sum . fmap genericLength)
|
||||
|
||||
instance NFData a => NFData (Patch a)
|
||||
|
||||
syncAsyncBenchmark :: Benchmark
|
||||
syncAsyncBenchmark =
|
||||
bgroup "async vs par" [
|
||||
bench "async" . whnfIO $ SemanticDiff.fetchDiffs =<< theArgs,
|
||||
bench "par" . whnfIO $ SemanticDiffPar.fetchDiffs =<< theArgs
|
||||
]
|
||||
|
||||
theArgs :: IO Arguments
|
||||
theArgs = do
|
||||
jqueryPath <- makeAbsolute "test/repos/jquery"
|
||||
pure $ args jqueryPath sha1 sha2 files R.Patch
|
||||
where
|
||||
sha1 = "70526981916945dc4093e116a3de61b1777d4718"
|
||||
sha2 = "e5ffcb0838c894e26f4ff32dfec162cf624d8d7d"
|
||||
files = [
|
||||
"src/manipulation/getAll.js",
|
||||
"src/manipulation/support.js",
|
||||
"src/manipulation/wrapMap.js",
|
||||
"src/offset.js",
|
||||
"test/unit/css.js",
|
||||
"test/unit/deferred.js",
|
||||
"test/unit/deprecated.js",
|
||||
"test/unit/effects.js",
|
||||
"test/unit/event.js",
|
||||
"test/unit/offset.js",
|
||||
"test/unit/wrap.js"
|
||||
]
|
@ -1,12 +0,0 @@
|
||||
module SemanticDiffPar where
|
||||
|
||||
import Arguments
|
||||
import qualified Control.Monad.Par.IO as ParIO
|
||||
import Control.Monad.Reader
|
||||
import qualified Data.Text as T
|
||||
import Prologue
|
||||
import qualified Renderer as R
|
||||
import SemanticDiff
|
||||
|
||||
fetchDiffs :: Arguments -> IO [T.Text]
|
||||
fetchDiffs args@Arguments{..} = pure . pure . R.concatOutputs =<< (ParIO.runParIO . liftIO $ for filePaths (fetchDiff args))
|
@ -40,28 +40,28 @@ generate_example () {
|
||||
diffFileBA="${fileB%%.*}.diffB-A.txt"
|
||||
|
||||
status $parseFileA
|
||||
stack exec semantic-diff -- --sexpression --parse $fileA > $parseFileA
|
||||
stack exec semantic parse -- --sexpression $fileA > $parseFileA
|
||||
|
||||
status $parseFileB
|
||||
stack exec semantic-diff -- --sexpression --parse $fileB > $parseFileB
|
||||
stack exec semantic parse -- --sexpression $fileB > $parseFileB
|
||||
|
||||
status $diffFileAddA
|
||||
stack exec semantic-diff -- --sexpression --no-index /dev/null $fileA > $diffFileAddA
|
||||
stack exec semantic diff -- --sexpression /dev/null $fileA > $diffFileAddA
|
||||
|
||||
status $diffFileRemoveA
|
||||
stack exec semantic-diff -- --sexpression --no-index $fileA /dev/null > $diffFileRemoveA
|
||||
stack exec semantic diff -- --sexpression $fileA /dev/null > $diffFileRemoveA
|
||||
|
||||
status $diffFileAddB
|
||||
stack exec semantic-diff -- --sexpression --no-index /dev/null $fileB > $diffFileAddB
|
||||
stack exec semantic diff -- --sexpression --no-index /dev/null $fileB > $diffFileAddB
|
||||
|
||||
status $diffFileRemoveB
|
||||
stack exec semantic-diff -- --sexpression --no-index $fileB /dev/null > $diffFileRemoveB
|
||||
stack exec semantic diff -- --sexpression $fileB /dev/null > $diffFileRemoveB
|
||||
|
||||
status $diffFileAB
|
||||
stack exec semantic-diff -- --sexpression --no-index $fileA $fileB > $diffFileAB
|
||||
stack exec semantic diff -- --sexpression $fileA $fileB > $diffFileAB
|
||||
|
||||
status $diffFileBA
|
||||
stack exec semantic-diff -- --sexpression --no-index $fileB $fileA > $diffFileBA
|
||||
stack exec semantic diff -- --sexpression $fileB $fileA > $diffFileBA
|
||||
}
|
||||
|
||||
if [[ -d $1 ]]; then
|
||||
|
@ -1,5 +1,5 @@
|
||||
name: semantic-diff
|
||||
version: 0.2.0
|
||||
version: 0.3.0
|
||||
synopsis: Initial project template from stack
|
||||
description: Please see README.md
|
||||
homepage: http://github.com/github/semantic-diff#readme
|
||||
@ -63,7 +63,7 @@ library
|
||||
, Renderer.Summary
|
||||
, Renderer.SExpression
|
||||
, Renderer.TOC
|
||||
, SemanticDiff
|
||||
, Semantic
|
||||
, SES
|
||||
, SES.Myers
|
||||
, Source
|
||||
@ -130,7 +130,7 @@ library
|
||||
ghc-options: -Wall -fno-warn-name-shadowing -O2 -j
|
||||
ghc-prof-options: -fprof-auto
|
||||
|
||||
executable semantic-diff
|
||||
executable semantic
|
||||
hs-source-dirs: app
|
||||
main-is: Main.hs
|
||||
ghc-options: -threaded -rtsopts "-with-rtsopts=-N -A4m -n2m" -static -j -O2 -pgml=script/g++
|
||||
@ -141,23 +141,6 @@ executable semantic-diff
|
||||
default-language: Haskell2010
|
||||
default-extensions: FlexibleInstances, OverloadedStrings, NoImplicitPrelude, RecordWildCards
|
||||
|
||||
benchmark semantic-diff-bench
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Main.hs
|
||||
hs-source-dirs: bench
|
||||
other-modules: SemanticDiffPar
|
||||
build-depends: base
|
||||
, criterion
|
||||
, directory
|
||||
, leancheck
|
||||
, monad-par
|
||||
, mtl
|
||||
, semantic-diff
|
||||
, text >= 1.2.1.3
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N -j -O2 -static -pgml=script/g++
|
||||
default-language: Haskell2010
|
||||
default-extensions: FlexibleInstances, OverloadedStrings, NoImplicitPrelude, RecordWildCards
|
||||
|
||||
test-suite test
|
||||
type: exitcode-stdio-1.0
|
||||
hs-source-dirs: test
|
||||
@ -170,6 +153,7 @@ test-suite test
|
||||
, Data.RandomWalkSimilarity.Spec
|
||||
, Data.Syntax.Assignment.Spec
|
||||
, DiffSpec
|
||||
, SemanticSpec
|
||||
, SummarySpec
|
||||
, GitmonClientSpec
|
||||
, InterpreterSpec
|
||||
|
168
src/Arguments.hs
168
src/Arguments.hs
@ -1,153 +1,37 @@
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# OPTIONS_GHC -funbox-strict-fields #-}
|
||||
module Arguments (Arguments(..), CmdLineOptions(..), DiffMode(..), ExtraArg(..), RunMode(..), programArguments, args, diffPathsArgs, parseArgs) where
|
||||
module Arguments where
|
||||
|
||||
import Data.Functor.Both
|
||||
import Command
|
||||
import Data.Maybe
|
||||
import Data.List.Split
|
||||
import Prologue hiding ((<>))
|
||||
import Prelude
|
||||
import System.Environment
|
||||
import System.Directory
|
||||
import System.FilePath.Posix (takeFileName, (-<.>))
|
||||
import System.IO.Error (IOError)
|
||||
|
||||
import qualified Renderer as R
|
||||
|
||||
data ExtraArg = ShaPair (Both (Maybe String))
|
||||
| FileArg FilePath
|
||||
deriving (Show)
|
||||
data DiffMode = DiffCommits String String [FilePath] | DiffPaths FilePath FilePath
|
||||
deriving Show
|
||||
|
||||
data DiffMode = PathDiff (Both FilePath)
|
||||
| CommitDiff
|
||||
deriving (Show)
|
||||
|
||||
data RunMode = Diff
|
||||
| Parse
|
||||
deriving (Show)
|
||||
|
||||
-- | The command line options to the application (arguments for optparse-applicative).
|
||||
data CmdLineOptions = CmdLineOptions
|
||||
{ outputFormat :: R.Format
|
||||
, maybeTimeout :: Maybe Float
|
||||
, outputFilePath :: Maybe FilePath
|
||||
, commitSha' :: Maybe String
|
||||
, noIndex :: Bool
|
||||
, extraArgs :: [ExtraArg]
|
||||
, debug' :: Bool
|
||||
, runMode' :: RunMode
|
||||
}
|
||||
|
||||
-- | Arguments for the program (includes command line, environment, and defaults).
|
||||
data Arguments = Arguments
|
||||
{ gitDir :: FilePath
|
||||
, alternateObjectDirs :: [FilePath]
|
||||
, format :: R.Format
|
||||
, timeoutInMicroseconds :: Int
|
||||
, outputPath :: Maybe FilePath
|
||||
, commitSha :: Maybe String
|
||||
data DiffArguments = DiffArguments
|
||||
{ encodeDiff :: DiffEncoder
|
||||
, diffMode :: DiffMode
|
||||
, runMode :: RunMode
|
||||
, shaRange :: Both (Maybe String)
|
||||
, filePaths :: [FilePath]
|
||||
, gitDir :: FilePath
|
||||
, alternateObjectDirs :: [FilePath]
|
||||
} deriving Show
|
||||
|
||||
data ParseMode = ParseCommit String [FilePath] | ParsePaths [FilePath]
|
||||
deriving Show
|
||||
|
||||
data ParseArguments = ParseArguments
|
||||
{ renderParseTree :: ParseTreeRenderer
|
||||
, parseMode :: ParseMode
|
||||
, debug :: Bool
|
||||
} deriving (Show)
|
||||
, gitDir :: FilePath
|
||||
, alternateObjectDirs :: [FilePath]
|
||||
} deriving Show
|
||||
|
||||
-- | Returns Arguments for the program from parsed command line arguments.
|
||||
programArguments :: CmdLineOptions -> IO Arguments
|
||||
programArguments CmdLineOptions{..} = do
|
||||
pwd <- getCurrentDirectory
|
||||
gitDir <- fromMaybe pwd <$> lookupEnv "GIT_DIR"
|
||||
eitherObjectDirs <- try $ parseObjectDirs . toS <$> getEnv "GIT_ALTERNATE_OBJECT_DIRECTORIES"
|
||||
outputPath <- getOutputPath outputFilePath
|
||||
let alternateObjectDirs = case (eitherObjectDirs :: Either IOError [FilePath]) of
|
||||
(Left _) -> []
|
||||
(Right objectDirs) -> objectDirs
|
||||
data ProgramMode = Parse ParseArguments | Diff DiffArguments
|
||||
deriving Show
|
||||
|
||||
let filePaths = fetchPaths extraArgs
|
||||
pure Arguments
|
||||
{ gitDir = gitDir
|
||||
, alternateObjectDirs = alternateObjectDirs
|
||||
, format = outputFormat
|
||||
, timeoutInMicroseconds = maybe defaultTimeout toMicroseconds maybeTimeout
|
||||
, outputPath = outputPath
|
||||
, commitSha = commitSha'
|
||||
, diffMode = case (noIndex, filePaths) of
|
||||
(True, [fileA, fileB]) -> PathDiff (both fileA fileB)
|
||||
(_, _) -> CommitDiff
|
||||
, runMode = runMode'
|
||||
, shaRange = fetchShas extraArgs
|
||||
, filePaths = filePaths
|
||||
, debug = debug'
|
||||
}
|
||||
where
|
||||
fetchPaths :: [ExtraArg] -> [FilePath]
|
||||
fetchPaths [] = []
|
||||
fetchPaths (FileArg x:xs) = x : fetchPaths xs
|
||||
fetchPaths (_:xs) = fetchPaths xs
|
||||
|
||||
fetchShas :: [ExtraArg] -> Both (Maybe String)
|
||||
fetchShas [] = both Nothing Nothing
|
||||
fetchShas (ShaPair x:_) = x
|
||||
fetchShas (_:xs) = fetchShas xs
|
||||
|
||||
getOutputPath Nothing = pure Nothing
|
||||
getOutputPath (Just path) = do
|
||||
isDir <- doesDirectoryExist path
|
||||
pure . Just $ if isDir then takeFileName path -<.> ".html" else path
|
||||
|
||||
|
||||
-- | Quickly assemble an Arguments data record with defaults.
|
||||
args :: FilePath -> String -> String -> [String] -> R.Format -> Arguments
|
||||
args gitDir sha1 sha2 filePaths format = Arguments
|
||||
{ gitDir = gitDir
|
||||
, alternateObjectDirs = []
|
||||
, format = format
|
||||
, timeoutInMicroseconds = defaultTimeout
|
||||
, outputPath = Nothing
|
||||
, commitSha = Nothing
|
||||
, diffMode = CommitDiff
|
||||
, runMode = Diff
|
||||
, shaRange = Just <$> both sha1 sha2
|
||||
, filePaths = filePaths
|
||||
, debug = False
|
||||
}
|
||||
|
||||
diffPathsArgs :: FilePath -> Both FilePath -> R.Format -> Arguments
|
||||
diffPathsArgs gitDir paths format = Arguments
|
||||
{ gitDir = gitDir
|
||||
, alternateObjectDirs = []
|
||||
, format = format
|
||||
, timeoutInMicroseconds = defaultTimeout
|
||||
, outputPath = Nothing
|
||||
, commitSha = Nothing
|
||||
, diffMode = PathDiff paths
|
||||
, runMode = Diff
|
||||
, shaRange = both Nothing Nothing
|
||||
, filePaths = []
|
||||
, debug = False
|
||||
}
|
||||
|
||||
parseArgs :: [String] -> R.Format -> Arguments
|
||||
parseArgs filePaths format = Arguments
|
||||
{ gitDir = ""
|
||||
, alternateObjectDirs = []
|
||||
, format = format
|
||||
, timeoutInMicroseconds = defaultTimeout
|
||||
, outputPath = Nothing
|
||||
, commitSha = Nothing
|
||||
, diffMode = CommitDiff
|
||||
, runMode = Parse
|
||||
, shaRange = both Nothing Nothing
|
||||
, filePaths = filePaths
|
||||
, debug = False
|
||||
}
|
||||
|
||||
-- | 7 seconds
|
||||
defaultTimeout :: Int
|
||||
defaultTimeout = 7 * 1000000
|
||||
|
||||
toMicroseconds :: Float -> Int
|
||||
toMicroseconds num = floor $ num * 1000000
|
||||
|
||||
parseObjectDirs :: FilePath -> [FilePath]
|
||||
parseObjectDirs = splitWhen (== ':')
|
||||
data Arguments = Arguments
|
||||
{ programMode :: ProgramMode
|
||||
, outputFilePath :: Maybe FilePath
|
||||
} deriving Show
|
||||
|
@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE DataKinds, GADTs #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
module Command
|
||||
( Command
|
||||
-- Constructors
|
||||
@ -10,6 +11,14 @@ module Command
|
||||
, maybeDiff
|
||||
, renderDiffs
|
||||
, concurrently
|
||||
, patchDiff
|
||||
, splitDiff
|
||||
, jsonDiff
|
||||
, summaryDiff
|
||||
, sExpressionDiff
|
||||
, tocDiff
|
||||
, DiffEncoder
|
||||
, ParseTreeRenderer
|
||||
-- Evaluation
|
||||
, runCommand
|
||||
) where
|
||||
@ -20,15 +29,16 @@ import Control.Exception (catch)
|
||||
import Control.Monad.Free.Freer
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Parallel.Strategies
|
||||
import Data.Aeson hiding (json)
|
||||
import qualified Data.ByteString as B
|
||||
import Data.Functor.Both
|
||||
import Data.Functor.Classes
|
||||
import Data.Functor.Listable
|
||||
import Data.List ((\\), nub)
|
||||
import Data.RandomWalkSimilarity
|
||||
import Data.Record
|
||||
import Data.String
|
||||
import Diff
|
||||
import Info
|
||||
import Interpreter
|
||||
import GHC.Conc (numCapabilities)
|
||||
import qualified Git
|
||||
import Git.Blob
|
||||
@ -37,14 +47,19 @@ import Git.Libgit2.Backend
|
||||
import Git.Repository
|
||||
import Git.Types
|
||||
import GitmonClient
|
||||
import Info
|
||||
import Interpreter
|
||||
import Language
|
||||
import Patch
|
||||
import Prologue hiding (concurrently, Concurrently, readFile)
|
||||
import qualified Renderer as R
|
||||
import qualified Renderer.SExpression as R
|
||||
import Renderer
|
||||
import Source
|
||||
import Syntax
|
||||
import System.FilePath
|
||||
import Term
|
||||
import Text.Show
|
||||
|
||||
|
||||
-- | High-level commands encapsulating the work done to perform a diff or parse operation.
|
||||
@ -188,5 +203,69 @@ runRenderDiffs :: Monoid output => DiffRenderer fields output -> [(Both SourceBl
|
||||
runRenderDiffs = runDiffRenderer
|
||||
|
||||
|
||||
type ParseTreeRenderer = Bool -> [SourceBlob] -> IO ByteString
|
||||
|
||||
type DiffEncoder = [(Both SourceBlob, Diff (Syntax Text) (Record DefaultFields))] -> Command ByteString
|
||||
|
||||
patchDiff :: DiffEncoder
|
||||
patchDiff = fmap encodeText . renderDiffs R.PatchRenderer
|
||||
|
||||
splitDiff :: DiffEncoder
|
||||
splitDiff = fmap encodeText . renderDiffs R.SplitRenderer
|
||||
|
||||
jsonDiff :: DiffEncoder
|
||||
jsonDiff = fmap encodeJSON . renderDiffs R.JSONDiffRenderer
|
||||
|
||||
summaryDiff :: DiffEncoder
|
||||
summaryDiff = fmap encodeSummaries . renderDiffs R.SummaryRenderer
|
||||
|
||||
sExpressionDiff :: DiffEncoder
|
||||
sExpressionDiff = renderDiffs (R.SExpressionDiffRenderer R.TreeOnly)
|
||||
|
||||
tocDiff :: DiffEncoder
|
||||
tocDiff = fmap encodeSummaries . renderDiffs R.ToCRenderer
|
||||
|
||||
encodeJSON :: Map Text Value -> ByteString
|
||||
encodeJSON = toS . (<> "\n") . encode
|
||||
|
||||
encodeText :: File -> ByteString
|
||||
encodeText = encodeUtf8 . R.unFile
|
||||
|
||||
encodeSummaries :: Summaries -> ByteString
|
||||
encodeSummaries = toS . (<> "\n") . encode
|
||||
|
||||
|
||||
instance Show ParseTreeRenderer where
|
||||
showsPrec d _ = showParen (d >= 10) $ showString "ParseTreeRenderer "
|
||||
|
||||
instance Listable ParseTreeRenderer where
|
||||
tiers = cons0 jsonParseTree
|
||||
\/ cons0 jsonIndexParseTree
|
||||
\/ cons0 sExpressionParseTree
|
||||
|
||||
instance Show DiffEncoder where
|
||||
showsPrec d encodeDiff = showParen (d >= 10) $ showString "DiffEncoder "
|
||||
. showsPrec 10 (encodeDiff []) . showChar ' '
|
||||
|
||||
instance Listable DiffEncoder where
|
||||
tiers = cons0 patchDiff
|
||||
\/ cons0 splitDiff
|
||||
\/ cons0 jsonDiff
|
||||
\/ cons0 summaryDiff
|
||||
\/ cons0 sExpressionDiff
|
||||
\/ cons0 tocDiff
|
||||
|
||||
instance MonadIO Command where
|
||||
liftIO io = LiftIO io `Then` return
|
||||
|
||||
instance Show1 CommandF where
|
||||
liftShowsPrec sp sl d command = case command of
|
||||
ReadFile path -> showsUnaryWith showsPrec "ReadFile" d path
|
||||
ReadFilesAtSHAs gitDir alternates paths shas -> showsQuaternaryWith showsPrec showsPrec showsPrec showsPrec "ReadFilesAtSHAs" d gitDir alternates paths shas
|
||||
where showsQuaternaryWith sp1 sp2 sp3 sp4 name d x y z w = showParen (d > 10) $
|
||||
showString name . showChar ' ' . sp1 11 x . showChar ' ' . sp2 11 y . showChar ' ' . sp3 11 z . showChar ' ' . sp4 11 w
|
||||
Parse language _ -> showsBinaryWith showsPrec (const showChar) "Parse" d language '_'
|
||||
Diff _ -> showsUnaryWith (const showChar) "Diff" d '_'
|
||||
RenderDiffs renderer _ -> showsBinaryWith showsPrec (const showChar) "RenderDiffs" d renderer '_'
|
||||
Concurrently commands f -> showsBinaryWith (liftShowsPrec sp sl) (const showChar) "Concurrently" d (traverse f commands) '_'
|
||||
LiftIO _ -> showsUnaryWith (const showChar) "LiftIO" d '_'
|
||||
|
@ -1,7 +1,6 @@
|
||||
{-# LANGUAGE DataKinds, GADTs, GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeFamilies, TypeOperators #-}
|
||||
module Command.Parse where
|
||||
|
||||
import Arguments
|
||||
import Category
|
||||
import Data.Aeson (ToJSON, toJSON, encode, object, (.=))
|
||||
import Data.Aeson.Types (Pair)
|
||||
@ -65,17 +64,15 @@ parseNodeToJSONFields ParseNode{..} =
|
||||
<> [ "identifier" .= identifier | isJust identifier ]
|
||||
|
||||
-- | Parses file contents into an SExpression format for the provided arguments.
|
||||
parseSExpression :: Arguments -> IO ByteString
|
||||
parseSExpression =
|
||||
pure . printTerms TreeOnly <=< parse <=< sourceBlobsFromArgs
|
||||
sExpressionParseTree :: Bool -> [SourceBlob] -> IO ByteString
|
||||
sExpressionParseTree _ blobs =
|
||||
pure . printTerms TreeOnly =<< parse blobs
|
||||
where parse = traverse (\sourceBlob@SourceBlob{..} -> parserForType (toS (takeExtension path)) sourceBlob)
|
||||
|
||||
type RAlgebra t a = Base t (t, a) -> a
|
||||
|
||||
parseRoot :: (FilePath -> f ParseNode -> root) -> (ParseNode -> [f ParseNode] -> f ParseNode) -> Arguments -> IO [root]
|
||||
parseRoot construct combine args@Arguments{..} = do
|
||||
blobs <- sourceBlobsFromArgs args
|
||||
for blobs (\ sourceBlob@SourceBlob{..} -> do
|
||||
parseRoot :: Bool -> (FilePath -> f ParseNode -> root) -> (ParseNode -> [f ParseNode] -> f ParseNode) -> [SourceBlob] -> IO [root]
|
||||
parseRoot debug construct combine blobs = for blobs (\ sourceBlob@SourceBlob{..} -> do
|
||||
parsedTerm <- parseWithDecorator (decorator source) path sourceBlob
|
||||
pure $! construct path (para algebra parsedTerm))
|
||||
where algebra (annotation :< syntax) = combine (makeNode annotation (Prologue.fst <$> syntax)) (toList (Prologue.snd <$> syntax))
|
||||
@ -85,12 +82,12 @@ parseRoot construct combine args@Arguments{..} = do
|
||||
ParseNode (toS category) range head sourceSpan (identifierFor syntax)
|
||||
|
||||
-- | Constructs IndexFile nodes for the provided arguments and encodes them to JSON.
|
||||
parseIndex :: Arguments -> IO ByteString
|
||||
parseIndex = fmap (toS . encode) . parseRoot IndexFile (\ node siblings -> node : concat siblings)
|
||||
jsonIndexParseTree :: Bool -> [SourceBlob] -> IO ByteString
|
||||
jsonIndexParseTree debug = fmap (toS . encode) . parseRoot debug IndexFile (\ node siblings -> node : concat siblings)
|
||||
|
||||
-- | Constructs ParseTreeFile nodes for the provided arguments and encodes them to JSON.
|
||||
parseTree :: Arguments -> IO ByteString
|
||||
parseTree = fmap (toS . encode) . parseRoot ParseTreeFile Rose
|
||||
jsonParseTree :: Bool -> [SourceBlob] -> IO ByteString
|
||||
jsonParseTree debug = fmap (toS . encode) . parseRoot debug ParseTreeFile Rose
|
||||
|
||||
-- | Determines the term decorator to use when parsing.
|
||||
parseDecorator :: (Functor f, HasField fields Range) => Bool -> (Source -> TermDecorator f fields (Maybe SourceText))
|
||||
@ -138,13 +135,6 @@ sourceBlobsFromSha commitSha gitDir filePaths = do
|
||||
identifierFor :: (HasField fields (Maybe SourceText), HasField fields Category, StringConv leaf Text) => Syntax leaf (Term (Syntax leaf) (Record fields)) -> Maybe Text
|
||||
identifierFor = fmap toS . extractLeafValue . unwrap <=< maybeIdentifier
|
||||
|
||||
-- | For the file paths and commit sha provided, extract only the BlobEntries and represent them as SourceBlobs.
|
||||
sourceBlobsFromArgs :: Arguments -> IO [SourceBlob]
|
||||
sourceBlobsFromArgs Arguments{..} =
|
||||
case commitSha of
|
||||
Just commitSha' -> sourceBlobsFromSha commitSha' gitDir filePaths
|
||||
_ -> sourceBlobsFromPaths filePaths
|
||||
|
||||
-- | Return a parser incorporating the provided TermDecorator.
|
||||
parseWithDecorator :: TermDecorator (Syntax Text) DefaultFields field -> FilePath -> Parser (Syntax Text) (Record (field ': DefaultFields))
|
||||
parseWithDecorator decorator path blob = decorateTerm decorator <$> parserForType (toS (takeExtension path)) blob
|
||||
|
@ -2,15 +2,15 @@
|
||||
module Renderer
|
||||
( DiffRenderer(..)
|
||||
, runDiffRenderer
|
||||
, Format(..)
|
||||
, Summaries(..)
|
||||
, File(..)
|
||||
) where
|
||||
|
||||
import Data.Aeson (ToJSON, Value)
|
||||
import Data.Functor.Both
|
||||
import Data.Functor.Classes
|
||||
import Text.Show
|
||||
import Data.Map as Map hiding (null)
|
||||
import Data.Functor.Listable
|
||||
import Data.Record
|
||||
import Diff
|
||||
import Info
|
||||
@ -41,21 +41,17 @@ runDiffRenderer renderer = foldMap . uncurry $ case renderer of
|
||||
SExpressionDiffRenderer format -> R.sExpression format
|
||||
ToCRenderer -> R.toc
|
||||
|
||||
-- | The available types of diff rendering.
|
||||
data Format = Split | Patch | JSON | Summary | SExpression | TOC | Index | ParseTree
|
||||
deriving (Show)
|
||||
|
||||
newtype File = File { unFile :: Text }
|
||||
deriving Show
|
||||
|
||||
instance Show (DiffRenderer fields output) where
|
||||
showsPrec _ SplitRenderer = showString "SplitRenderer"
|
||||
showsPrec _ PatchRenderer = showString "PatchRenderer"
|
||||
showsPrec _ JSONDiffRenderer = showString "JSONDiffRenderer"
|
||||
showsPrec _ SummaryRenderer = showString "SummaryRenderer"
|
||||
showsPrec d (SExpressionDiffRenderer format) = showsUnaryWith showsPrec "SExpressionDiffRenderer" d format
|
||||
showsPrec _ ToCRenderer = showString "ToCRenderer"
|
||||
|
||||
instance Monoid File where
|
||||
mempty = File mempty
|
||||
mappend (File a) (File b) = File (a <> "\n" <> b)
|
||||
|
||||
instance Listable Format where
|
||||
tiers = cons0 Split
|
||||
\/ cons0 Patch
|
||||
\/ cons0 JSON
|
||||
\/ cons0 Summary
|
||||
\/ cons0 SExpression
|
||||
\/ cons0 TOC
|
||||
|
@ -15,6 +15,7 @@ import Syntax
|
||||
import Term
|
||||
|
||||
data SExpressionFormat = TreeOnly | TreeAndRanges
|
||||
deriving (Show)
|
||||
|
||||
sExpression :: (HasField fields Category, HasField fields SourceSpan) => SExpressionFormat -> Both SourceBlob -> Diff (Syntax Text) (Record fields) -> ByteString
|
||||
sExpression format _ diff = printDiff diff 0 format
|
||||
|
128
src/Semantic.hs
Normal file
128
src/Semantic.hs
Normal file
@ -0,0 +1,128 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
module Semantic (main, runDiff, runParse) where
|
||||
|
||||
import Arguments
|
||||
import Command
|
||||
import Command.Parse
|
||||
import Data.Functor.Both
|
||||
import Data.List.Split (splitWhen)
|
||||
import Data.String
|
||||
import Data.Version (showVersion)
|
||||
import Development.GitRev
|
||||
import Options.Applicative hiding (action)
|
||||
import Prologue hiding (concurrently, fst, snd, readFile)
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Paths_semantic_diff as Library (version)
|
||||
import Source
|
||||
import System.Directory
|
||||
import System.Environment
|
||||
import System.FilePath.Posix (takeFileName, (-<.>))
|
||||
import System.IO.Error (IOError)
|
||||
import Text.Regex
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
gitDir <- findGitDir
|
||||
alternates <- findAlternates
|
||||
Arguments{..} <- customExecParser (prefs showHelpOnEmpty) (arguments gitDir alternates)
|
||||
outputPath <- getOutputPath outputFilePath
|
||||
text <- case programMode of
|
||||
Diff args -> runDiff args
|
||||
Parse args -> runParse args
|
||||
writeToOutput outputPath text
|
||||
|
||||
where
|
||||
findGitDir = do
|
||||
pwd <- getCurrentDirectory
|
||||
fromMaybe pwd <$> lookupEnv "GIT_DIR"
|
||||
|
||||
findAlternates = do
|
||||
eitherObjectDirs <- try $ splitWhen (== ':') . toS <$> getEnv "GIT_ALTERNATE_OBJECT_DIRECTORIES"
|
||||
pure $ case (eitherObjectDirs :: Either IOError [FilePath]) of
|
||||
(Left _) -> []
|
||||
(Right objectDirs) -> objectDirs
|
||||
|
||||
getOutputPath Nothing = pure Nothing
|
||||
getOutputPath (Just path) = do
|
||||
isDir <- doesDirectoryExist path
|
||||
pure . Just $ if isDir then takeFileName path -<.> ".html" else path
|
||||
|
||||
writeToOutput :: Maybe FilePath -> ByteString -> IO ()
|
||||
writeToOutput = maybe B.putStr B.writeFile
|
||||
|
||||
runDiff :: DiffArguments -> IO ByteString
|
||||
runDiff DiffArguments{..} = runCommand $ do
|
||||
diffs <- case diffMode of
|
||||
DiffPaths pathA pathB -> do
|
||||
let paths = both pathA pathB
|
||||
blobs <- traverse readFile paths
|
||||
terms <- traverse (traverse parseBlob) blobs
|
||||
diff' <- maybeDiff terms
|
||||
pure [(fromMaybe . emptySourceBlob <$> paths <*> blobs, diff')]
|
||||
DiffCommits sha1 sha2 paths -> do
|
||||
blobPairs <- readFilesAtSHAs gitDir alternateObjectDirs paths (both sha1 sha2)
|
||||
concurrently blobPairs . uncurry $ \ path blobs -> do
|
||||
terms <- concurrently blobs (traverse parseBlob)
|
||||
diff' <- maybeDiff terms
|
||||
pure (fromMaybe <$> pure (emptySourceBlob path) <*> blobs, diff')
|
||||
encodeDiff (diffs >>= \ (blobs, diff) -> (,) blobs <$> toList diff)
|
||||
|
||||
runParse :: ParseArguments -> IO ByteString
|
||||
runParse ParseArguments{..} = do
|
||||
blobs <- case parseMode of
|
||||
ParseCommit sha paths -> sourceBlobsFromSha sha gitDir paths
|
||||
ParsePaths paths -> sourceBlobsFromPaths paths
|
||||
renderParseTree debug blobs
|
||||
|
||||
-- | A parser for the application's command-line arguments.
|
||||
arguments :: FilePath -> [FilePath] -> ParserInfo Arguments
|
||||
arguments gitDir alternates = 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 <> progDesc "Set the GIT_DIR environment variable to specify a different git repository. Set GIT_ALTERNATE_OBJECT_DIRECTORIES to specify location of alternates."
|
||||
<> header "semantic -- Parse and diff semantically"
|
||||
|
||||
argumentsParser = Arguments
|
||||
<$> hsubparser (diffCommand <> parseCommand)
|
||||
<*> optional (strOption (long "output" <> short 'o' <> help "Output path (directory for split diffs), defaults to stdout"))
|
||||
|
||||
diffCommand = command "diff" (info diffArgumentsParser (progDesc "Show changes between commits or paths"))
|
||||
diffArgumentsParser = Diff
|
||||
<$> ( DiffArguments
|
||||
<$> ( flag patchDiff patchDiff (long "patch" <> help "Output a patch(1)-compatible diff (default)")
|
||||
<|> flag' splitDiff (long "split" <> help "Output a split diff")
|
||||
<|> flag' jsonDiff (long "json" <> help "Output a json diff")
|
||||
<|> flag' summaryDiff (long "summary" <> help "Output a diff summary")
|
||||
<|> flag' sExpressionDiff (long "sexpression" <> help "Output an s-expression diff tree")
|
||||
<|> flag' tocDiff (long "toc" <> help "Output a table of contents diff summary") )
|
||||
<*> ( DiffPaths
|
||||
<$> argument str (metavar "FILE_A")
|
||||
<*> argument str (metavar "FILE_B")
|
||||
<|> DiffCommits
|
||||
<$> option (eitherReader parseSha) (long "sha1" <> metavar "SHA" <> help "Starting commit SHA")
|
||||
<*> option (eitherReader parseSha) (long "sha2" <> metavar "SHA" <> help "Ending commit SHA")
|
||||
<*> many (argument str (metavar "FILES...")) )
|
||||
<*> pure gitDir
|
||||
<*> pure alternates )
|
||||
|
||||
parseCommand = command "parse" (info parseArgumentsParser (progDesc "Print parse trees for a commit or paths"))
|
||||
parseArgumentsParser = Parse
|
||||
<$> ( ParseArguments
|
||||
<$> ( flag sExpressionParseTree sExpressionParseTree (long "sexpression" <> help "Output s-expression parse trees (default)")
|
||||
<|> flag' jsonParseTree (long "json" <> help "Output JSON parse trees")
|
||||
<|> flag' jsonIndexParseTree (long "index" <> help "Output JSON parse trees in index format") )
|
||||
<*> ( ParsePaths
|
||||
<$> some (argument str (metavar "FILES..."))
|
||||
<|> ParseCommit
|
||||
<$> option (eitherReader parseSha) (long "sha" <> metavar "SHA" <> help "Commit SHA")
|
||||
<*> some (argument str (metavar "FILES...")) )
|
||||
<*> switch (long "debug")
|
||||
<*> pure gitDir
|
||||
<*> pure alternates )
|
||||
|
||||
parseSha :: String -> Either String String
|
||||
parseSha s = case matchRegex regex s of
|
||||
Just [sha] -> Right sha
|
||||
_ -> Left $ s <> " is not a valid SHA-1"
|
||||
where regex = mkRegexWithOpts "([0-9a-f]{40})" True False
|
@ -1,94 +0,0 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
module SemanticDiff (main) where
|
||||
|
||||
import Arguments
|
||||
import Command
|
||||
import Command.Parse
|
||||
import Development.GitRev
|
||||
import Data.Aeson
|
||||
import qualified Data.ByteString as B
|
||||
import Data.Functor.Both
|
||||
import Data.String
|
||||
import Data.Version (showVersion)
|
||||
import Options.Applicative hiding (action)
|
||||
import qualified Paths_semantic_diff as Library (version)
|
||||
import Prologue hiding (concurrently, fst, snd, readFile)
|
||||
import qualified Renderer as R
|
||||
import qualified Renderer.SExpression as R
|
||||
import Source
|
||||
import Text.Regex
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
args@Arguments{..} <- programArguments =<< execParser argumentsParser
|
||||
text <- case runMode of
|
||||
Diff -> runCommand $ do
|
||||
let render = case format of
|
||||
R.Split -> fmap encodeText . renderDiffs R.SplitRenderer
|
||||
R.Patch -> fmap encodeText . renderDiffs R.PatchRenderer
|
||||
R.JSON -> fmap encodeJSON . renderDiffs R.JSONDiffRenderer
|
||||
R.Summary -> fmap encodeSummaries . renderDiffs R.SummaryRenderer
|
||||
R.SExpression -> renderDiffs (R.SExpressionDiffRenderer R.TreeOnly)
|
||||
R.TOC -> fmap encodeSummaries . renderDiffs R.ToCRenderer
|
||||
_ -> fmap encodeText . renderDiffs R.PatchRenderer
|
||||
diffs <- case diffMode of
|
||||
PathDiff paths -> do
|
||||
blobs <- traverse readFile paths
|
||||
terms <- traverse (traverse parseBlob) blobs
|
||||
diff' <- maybeDiff terms
|
||||
return [(fromMaybe . emptySourceBlob <$> paths <*> blobs, diff')]
|
||||
CommitDiff -> do
|
||||
blobPairs <- readFilesAtSHAs gitDir alternateObjectDirs filePaths (fromMaybe (toS nullOid) <$> shaRange)
|
||||
concurrently blobPairs . uncurry $ \ path blobs -> do
|
||||
terms <- concurrently blobs (traverse parseBlob)
|
||||
diff' <- maybeDiff terms
|
||||
return (fromMaybe <$> pure (emptySourceBlob path) <*> blobs, diff')
|
||||
render (diffs >>= \ (blobs, diff) -> (,) blobs <$> toList diff)
|
||||
Parse -> case format of
|
||||
R.Index -> parseIndex args
|
||||
R.SExpression -> parseSExpression args
|
||||
_ -> parseTree args
|
||||
writeToOutput outputPath text
|
||||
where encodeText = encodeUtf8 . R.unFile
|
||||
encodeJSON = toS . (<> "\n") . encode
|
||||
encodeSummaries = toS . (<> "\n") . encode
|
||||
|
||||
-- | A parser for the application's command-line arguments.
|
||||
argumentsParser :: ParserInfo CmdLineOptions
|
||||
argumentsParser = info (version <*> helper <*> argumentsP)
|
||||
(fullDesc <> progDesc "Set the GIT_DIR environment variable to specify the git repository. Set GIT_ALTERNATE_OBJECT_DIRECTORIES to specify location of alternates."
|
||||
<> header "semantic-diff - Show semantic changes between commits")
|
||||
where
|
||||
argumentsP :: Parser CmdLineOptions
|
||||
argumentsP = CmdLineOptions
|
||||
<$> (flag R.Split R.Patch (long "patch" <> help "output a patch(1)-compatible diff")
|
||||
<|> flag R.Split R.JSON (long "json" <> help "output a json diff")
|
||||
<|> flag' R.Split (long "split" <> help "output a split diff")
|
||||
<|> flag' R.Summary (long "summary" <> help "output a diff summary")
|
||||
<|> flag' R.SExpression (long "sexpression" <> help "output an s-expression diff tree")
|
||||
<|> flag' R.TOC (long "toc" <> help "output a table of contents diff summary")
|
||||
<|> flag' R.Index (long "index" <> help "output indexable JSON parse output")
|
||||
<|> flag' R.ParseTree (long "parse-tree" <> help "output JSON parse tree structure"))
|
||||
<*> optional (option auto (long "timeout" <> help "timeout for per-file diffs in seconds, defaults to 7 seconds"))
|
||||
<*> optional (strOption (long "output" <> short 'o' <> help "output directory for split diffs, defaults to stdout if unspecified"))
|
||||
<*> optional (strOption (long "commit" <> short 'c' <> help "single commit entry for parsing"))
|
||||
<*> switch (long "no-index" <> help "compare two paths on the filesystem")
|
||||
<*> some (argument (eitherReader parseShasAndFiles) (metavar "SHA_A..SHAB FILES..."))
|
||||
<*> switch (long "debug" <> short 'd' <> help "set debug mode for parsing which outputs sourcetext for each syntax node")
|
||||
<*> flag Diff Parse (long "parse" <> short 'p' <> help "parses a source file without diffing")
|
||||
where
|
||||
parseShasAndFiles :: String -> Either String ExtraArg
|
||||
parseShasAndFiles s = case matchRegex regex s of
|
||||
Just ["", sha2] -> Right . ShaPair $ both Nothing (Just sha2)
|
||||
Just [sha1, sha2] -> Right . ShaPair $ Just <$> both sha1 sha2
|
||||
_ -> Right $ FileArg s
|
||||
where regex = mkRegexWithOpts "([0-9a-f]{40})\\.\\.([0-9a-f]{40})" True False
|
||||
|
||||
versionString :: String
|
||||
versionString = "semantic-diff version " <> showVersion Library.version <> " (" <> $(gitHash) <> ")"
|
||||
|
||||
version :: Parser (a -> a)
|
||||
version = infoOption versionString (long "version" <> short 'V' <> help "output the version of the program")
|
||||
|
||||
writeToOutput :: Maybe FilePath -> ByteString -> IO ()
|
||||
writeToOutput = maybe B.putStr B.writeFile
|
@ -1,34 +1,20 @@
|
||||
module Command.Parse.Spec where
|
||||
|
||||
import Command.Parse
|
||||
import Data.Functor.Listable
|
||||
import Control.Monad
|
||||
import Prelude
|
||||
import Test.Hspec hiding (shouldBe, shouldNotBe, shouldThrow, errorCall)
|
||||
import Test.Hspec.Expectations.Pretty
|
||||
import Test.Hspec.LeanCheck
|
||||
import Test.LeanCheck
|
||||
import Arguments
|
||||
import Renderer
|
||||
|
||||
spec :: Spec
|
||||
spec = parallel $
|
||||
context "parse" $
|
||||
prop "all valid formats should produce output" . forAll (isParseFormat `filterT` tiers) $
|
||||
\format ->
|
||||
case format of
|
||||
SExpression -> do
|
||||
output <- parseSExpression $ parseArgs ["test/fixtures/ruby/and-or.A.rb"] format
|
||||
spec = parallel . context "parse" $ do
|
||||
let blobs = sourceBlobsFromPaths ["test/fixtures/ruby/and-or.A.rb"]
|
||||
it "should produce s-expression trees" $ do
|
||||
output <- sExpressionParseTree False =<< blobs
|
||||
output `shouldNotBe` ""
|
||||
Index -> do
|
||||
output <- parseIndex $ parseArgs ["test/fixtures/ruby/and-or.A.rb"] format
|
||||
it "should produce JSON trees" $ do
|
||||
output <- jsonParseTree False =<< blobs
|
||||
output `shouldNotBe` ""
|
||||
_ -> do
|
||||
output <- parseTree $ parseArgs ["test/fixtures/ruby/and-or.A.rb"] format
|
||||
it "should produce JSON index" $ do
|
||||
output <- jsonIndexParseTree False =<< blobs
|
||||
output `shouldNotBe` ""
|
||||
|
||||
isParseFormat :: Format -> Bool
|
||||
isParseFormat a | Index <- a = True
|
||||
| ParseTree <- a = True
|
||||
| JSON <- a = True
|
||||
| SExpression <- a = True
|
||||
| otherwise = False
|
||||
|
23
test/SemanticSpec.hs
Normal file
23
test/SemanticSpec.hs
Normal file
@ -0,0 +1,23 @@
|
||||
module SemanticSpec where
|
||||
|
||||
import Prologue
|
||||
import Arguments
|
||||
import Semantic
|
||||
import Test.Hspec hiding (shouldBe, shouldNotBe, shouldThrow, errorCall)
|
||||
import Test.Hspec.Expectations.Pretty
|
||||
import Test.Hspec.LeanCheck
|
||||
|
||||
spec :: Spec
|
||||
spec = parallel $ do
|
||||
describe "runDiff" $ do
|
||||
prop "produces diffs for all formats" $
|
||||
\ encoder -> do
|
||||
let mode = DiffPaths "test/fixtures/ruby/and-or.A.rb" "test/fixtures/ruby/and-or.B.rb"
|
||||
output <- runDiff $ DiffArguments encoder mode "" []
|
||||
output `shouldNotBe` ""
|
||||
describe "runParse" $ do
|
||||
prop "produces parse trees for all formats" $
|
||||
\ renderer -> do
|
||||
let mode = ParsePaths ["test/fixtures/ruby/and-or.A.rb"]
|
||||
output <- runParse $ ParseArguments renderer mode False "" []
|
||||
output `shouldNotBe` ""
|
@ -19,6 +19,7 @@ import qualified SourceSpec
|
||||
import qualified TermSpec
|
||||
import qualified TOCSpec
|
||||
import qualified IntegrationSpec
|
||||
import qualified SemanticSpec
|
||||
import Test.Hspec
|
||||
|
||||
main :: IO ()
|
||||
@ -39,6 +40,7 @@ main = hspec $ do
|
||||
describe "SES.Myers" SES.Myers.Spec.spec
|
||||
describe "Source" SourceSpec.spec
|
||||
describe "Term" TermSpec.spec
|
||||
describe "Semantic" SemanticSpec.spec
|
||||
describe "TOC" TOCSpec.spec
|
||||
describe "Integration" IntegrationSpec.spec
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user