From 444de2c260ff4d1e6cea77c20c9286e28d09aa6b Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Fri, 15 Feb 2019 13:11:24 -0800 Subject: [PATCH 01/18] Embrace proto schema for CLI --toc --- src/Semantic/Api/Helpers.hs | 5 +++++ src/Semantic/Api/TOCSummaries.hs | 10 ++++------ 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/src/Semantic/Api/Helpers.hs b/src/Semantic/Api/Helpers.hs index 5e86bc458..29ee3cab9 100644 --- a/src/Semantic/Api/Helpers.hs +++ b/src/Semantic/Api/Helpers.hs @@ -6,6 +6,7 @@ module Semantic.Api.Helpers , apiBlobToBlob , apiBlobPairToBlobPair , apiLanguageToLanguage + , apiBlobPairsToBlobPairs , languageToApiLanguage ) where @@ -15,6 +16,7 @@ import qualified Data.Language as Data import Data.Source (fromText) import qualified Data.Span as Data import qualified Data.Text as T +import qualified Data.Vector as V import Data.These import qualified Semantic.Api.LegacyTypes as Legacy import qualified Semantic.Api.V1.CodeAnalysisPB as API @@ -67,6 +69,9 @@ languageToApiLanguage = \case Data.TypeScript -> API.Typescript Data.PHP -> API.Php +apiBlobPairsToBlobPairs :: V.Vector API.BlobPair -> [Data.BlobPair] +apiBlobPairsToBlobPairs = V.toList . fmap apiBlobPairToBlobPair + apiBlobPairToBlobPair :: API.BlobPair -> Data.BlobPair apiBlobPairToBlobPair (API.BlobPair (Just before) (Just after)) = Join (These (apiBlobToBlob before) (apiBlobToBlob after)) apiBlobPairToBlobPair (API.BlobPair (Just before) Nothing) = Join (This (apiBlobToBlob before)) diff --git a/src/Semantic/Api/TOCSummaries.hs b/src/Semantic/Api/TOCSummaries.hs index ff8d7c0b7..29f6abde3 100644 --- a/src/Semantic/Api/TOCSummaries.hs +++ b/src/Semantic/Api/TOCSummaries.hs @@ -19,10 +19,8 @@ import qualified Semantic.Api.V1.CodeAnalysisPB as API import Semantic.Task as Task import Serializing.Format -diffSummaryBuilder :: (DiffEffects sig m) => Format Summaries -> [BlobPair] -> m Builder -diffSummaryBuilder format blobs - -- TODO: Switch away from legacy format on CLI too. - = legacyDiffSummary blobs >>= serialize format +diffSummaryBuilder :: (DiffEffects sig m) => Format DiffTreeTOCResponse -> [BlobPair] -> m Builder +diffSummaryBuilder format blobs = diffSummary blobs >>= serialize format legacyDiffSummary :: (DiffEffects sig m) => [BlobPair] -> m Summaries legacyDiffSummary = distributeFoldMap go @@ -37,8 +35,8 @@ legacyDiffSummary = distributeFoldMap go render :: (Foldable syntax, Functor syntax, Applicative m) => BlobPair -> Diff syntax (Maybe Declaration) (Maybe Declaration) -> m Summaries render blobPair = pure . renderToCDiff blobPair -diffSummary :: (DiffEffects sig m) => [API.BlobPair] -> m DiffTreeTOCResponse -diffSummary blobs = DiffTreeTOCResponse . V.fromList <$> distributeFor (apiBlobPairToBlobPair <$> blobs) go +diffSummary :: (DiffEffects sig m) => [BlobPair] -> m DiffTreeTOCResponse +diffSummary blobs = DiffTreeTOCResponse . V.fromList <$> distributeFor blobs go where go :: (DiffEffects sig m) => BlobPair -> m TOCSummaryFile go blobPair = doDiff blobPair (decorate . declarationAlgebra) render From 58e521d0d164204d0d2123065143a2134e639128 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Fri, 15 Feb 2019 13:16:41 -0800 Subject: [PATCH 02/18] Embrace proto schema for CLI --symbols --- src/Semantic/Api/Helpers.hs | 44 ++++++++++++++++++++----------------- src/Semantic/Api/Symbols.hs | 8 +++---- 2 files changed, 27 insertions(+), 25 deletions(-) diff --git a/src/Semantic/Api/Helpers.hs b/src/Semantic/Api/Helpers.hs index 29ee3cab9..cc56a7aa6 100644 --- a/src/Semantic/Api/Helpers.hs +++ b/src/Semantic/Api/Helpers.hs @@ -3,11 +3,12 @@ module Semantic.Api.Helpers ( spanToSpan , spanToLegacySpan , toChangeType - , apiBlobToBlob - , apiBlobPairToBlobPair - , apiLanguageToLanguage - , apiBlobPairsToBlobPairs , languageToApiLanguage + , apiLanguageToLanguage + , apiBlobsToBlobs + , apiBlobToBlob + , apiBlobPairsToBlobPairs + , apiBlobPairToBlobPair ) where import Data.Bifunctor.Join @@ -36,8 +37,20 @@ toChangeType = \case "removed" -> API.Removed _ -> API.None -apiBlobToBlob :: API.Blob -> Data.Blob -apiBlobToBlob API.Blob{..} = Data.Blob (fromText content) (T.unpack path) (apiLanguageToLanguage language) +languageToApiLanguage :: Data.Language -> API.Language +languageToApiLanguage = \case + Data.Unknown -> API.Unknown + Data.Go -> API.Go + Data.Haskell -> API.Haskell + Data.Java -> API.Java + Data.JavaScript -> API.Javascript + Data.JSON -> API.Json + Data.JSX -> API.Jsx + Data.Markdown -> API.Markdown + Data.Python -> API.Python + Data.Ruby -> API.Ruby + Data.TypeScript -> API.Typescript + Data.PHP -> API.Php apiLanguageToLanguage :: API.Language -> Data.Language apiLanguageToLanguage = \case @@ -54,20 +67,11 @@ apiLanguageToLanguage = \case API.Typescript -> Data.TypeScript API.Php -> Data.PHP -languageToApiLanguage :: Data.Language -> API.Language -languageToApiLanguage = \case - Data.Unknown -> API.Unknown - Data.Go -> API.Go - Data.Haskell -> API.Haskell - Data.Java -> API.Java - Data.JavaScript -> API.Javascript - Data.JSON -> API.Json - Data.JSX -> API.Jsx - Data.Markdown -> API.Markdown - Data.Python -> API.Python - Data.Ruby -> API.Ruby - Data.TypeScript -> API.Typescript - Data.PHP -> API.Php +apiBlobsToBlobs :: V.Vector API.Blob -> [Data.Blob] +apiBlobsToBlobs = V.toList . fmap apiBlobToBlob + +apiBlobToBlob :: API.Blob -> Data.Blob +apiBlobToBlob API.Blob{..} = Data.Blob (fromText content) (T.unpack path) (apiLanguageToLanguage language) apiBlobPairsToBlobPairs :: V.Vector API.BlobPair -> [Data.BlobPair] apiBlobPairsToBlobPairs = V.toList . fmap apiBlobPairToBlobPair diff --git a/src/Semantic/Api/Symbols.hs b/src/Semantic/Api/Symbols.hs index aba033100..ec788e2eb 100644 --- a/src/Semantic/Api/Symbols.hs +++ b/src/Semantic/Api/Symbols.hs @@ -51,12 +51,10 @@ legacyParseSymbols blobs = Legacy.ParseTreeSymbolResponse <$> distributeFoldMap } parseSymbolsBuilder :: (Member Distribute sig, ParseEffects sig m, Traversable t) => t Blob -> m Builder -parseSymbolsBuilder blobs - -- TODO: Switch away from legacy format on CLI too. - = legacyParseSymbols blobs >>= serialize JSON +parseSymbolsBuilder blobs = parseSymbols blobs >>= serialize JSON -parseSymbols :: (Member Distribute sig, ParseEffects sig m, Traversable t) => t API.Blob -> m ParseTreeSymbolResponse -parseSymbols blobs = ParseTreeSymbolResponse . V.fromList . toList <$> distributeFor (apiBlobToBlob <$> blobs) go +parseSymbols :: (Member Distribute sig, ParseEffects sig m, Traversable t) => t Blob -> m ParseTreeSymbolResponse +parseSymbols blobs = ParseTreeSymbolResponse . V.fromList . toList <$> distributeFor blobs go where go :: (Member (Error SomeException) sig, Member Task sig, Carrier sig m, Monad m) => Blob -> m File go blob@Blob{..} = (doParse blob >>= withSomeTerm (renderToSymbols blob)) `catchError` (\(SomeException e) -> pure $ errorFile (show e)) From 290556901684354d8c028478714e1cdbb4d4cd03 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Fri, 15 Feb 2019 13:23:54 -0800 Subject: [PATCH 03/18] Embrace proto schema for CLI --json-graph --- src/Semantic/Api/Symbols.hs | 1 - src/Semantic/Api/Terms.hs | 12 +++--------- 2 files changed, 3 insertions(+), 10 deletions(-) diff --git a/src/Semantic/Api/Symbols.hs b/src/Semantic/Api/Symbols.hs index ec788e2eb..34ca3c0a2 100644 --- a/src/Semantic/Api/Symbols.hs +++ b/src/Semantic/Api/Symbols.hs @@ -22,7 +22,6 @@ import Semantic.Api.Helpers import qualified Semantic.Api.LegacyTypes as Legacy import Semantic.Api.Terms (ParseEffects, doParse) import Semantic.Api.V1.CodeAnalysisPB hiding (Blob) -import qualified Semantic.Api.V1.CodeAnalysisPB as API import Semantic.Task import Serializing.Format import Tags.Taggable diff --git a/src/Semantic/Api/Terms.hs b/src/Semantic/Api/Terms.hs index c2d58a4ad..9bf5ad7a3 100644 --- a/src/Semantic/Api/Terms.hs +++ b/src/Semantic/Api/Terms.hs @@ -38,14 +38,13 @@ import Rendering.JSON hiding (JSON) import qualified Rendering.JSON import Semantic.Api.Helpers import Semantic.Api.V1.CodeAnalysisPB hiding (Blob, Language (..)) -import qualified Semantic.Api.V1.CodeAnalysisPB as API import Semantic.Task import Serializing.Format hiding (JSON) import qualified Serializing.Format as Format import Tags.Taggable -termGraph :: (Traversable t, Member Distribute sig, ParseEffects sig m) => t API.Blob -> m ParseTreeGraphResponse -termGraph blobs = ParseTreeGraphResponse . V.fromList . toList <$> distributeFor (fmap apiBlobToBlob blobs) go +termGraph :: (Traversable t, Member Distribute sig, ParseEffects sig m) => t Blob -> m ParseTreeGraphResponse +termGraph blobs = ParseTreeGraphResponse . V.fromList . toList <$> distributeFor blobs go where go :: ParseEffects sig m => Blob -> m ParseTreeFileGraph go blob = (doParse blob >>= withSomeTerm (pure . render)) @@ -72,9 +71,7 @@ data TermOutputFormat parseTermBuilder :: (Traversable t, Member Distribute sig, ParseEffects sig m, MonadIO m) => TermOutputFormat-> t Blob -> m Builder parseTermBuilder TermJSONTree = distributeFoldMap jsonTerm >=> serialize Format.JSON -- NB: Serialize happens at the top level for these two JSON formats to collect results of multiple blobs. -parseTermBuilder TermJSONGraph = distributeFoldMap jsonGraph >=> serialize Format.JSON -- termGraph >=> serialize Format.JSON --- TODO: Switch Term Graph output on CLI to new format like this: --- parseTermBuilder TermJSONGraph = termGraph >=> serialize Format.JSON +parseTermBuilder TermJSONGraph = termGraph >=> serialize Format.JSON parseTermBuilder TermSExpression = distributeFoldMap sexpTerm parseTermBuilder TermDotGraph = distributeFoldMap dotGraphTerm parseTermBuilder TermShow = distributeFoldMap showTerm @@ -83,9 +80,6 @@ parseTermBuilder TermQuiet = distributeFoldMap quietTerm jsonTerm :: (ParseEffects sig m) => Blob -> m (Rendering.JSON.JSON "trees" SomeJSON) jsonTerm blob = (doParse blob >>= withSomeTerm (pure . renderJSONTerm blob)) `catchError` jsonError blob -jsonGraph :: (ParseEffects sig m) => Blob -> m (Rendering.JSON.JSON "trees" SomeJSON) -jsonGraph blob = (doParse blob >>= withSomeTerm (pure . renderJSONAdjTerm blob . renderTreeGraph)) `catchError` jsonError blob - jsonError :: Applicative m => Blob -> SomeException -> m (Rendering.JSON.JSON "trees" SomeJSON) jsonError blob (SomeException e) = pure $ renderJSONError blob (show e) From f2af85704b484d1de9198defb3a4b9edf79fa4f0 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Fri, 15 Feb 2019 13:26:42 -0800 Subject: [PATCH 04/18] Embrace proto schema for CLI diff --json-graph --- src/Semantic/Api/Diffs.hs | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/src/Semantic/Api/Diffs.hs b/src/Semantic/Api/Diffs.hs index 4ff363278..88b7d61bc 100644 --- a/src/Semantic/Api/Diffs.hs +++ b/src/Semantic/Api/Diffs.hs @@ -51,9 +51,7 @@ data DiffOutputFormat parseDiffBuilder :: (Traversable t, DiffEffects sig m) => DiffOutputFormat -> t BlobPair -> m Builder parseDiffBuilder DiffJSONTree = distributeFoldMap (jsonDiff renderJSONTree) >=> serialize Format.JSON -- NB: Serialize happens at the top level for these two JSON formats to collect results of multiple blob pairs. -parseDiffBuilder DiffJSONGraph = distributeFoldMap (jsonDiff renderJSONGraph) >=> serialize Format.JSON --- TODO: Switch Diff Graph output on CLI to new format like this: --- parseDiffBuilder DiffJSONGraph = diffGraph >=> serialize Format.JSON +parseDiffBuilder DiffJSONGraph = diffGraph >=> serialize Format.JSON parseDiffBuilder DiffSExpression = distributeFoldMap sexpDiff parseDiffBuilder DiffShow = distributeFoldMap showDiff parseDiffBuilder DiffDotGraph = distributeFoldMap dotGraphDiff @@ -69,11 +67,8 @@ jsonError blobPair (SomeException e) = pure $ renderJSONDiffError blobPair (show renderJSONTree :: (Applicative m, ToJSONFields1 syntax) => BlobPair -> Diff syntax Location Location -> m (Rendering.JSON.JSON "diffs" SomeJSON) renderJSONTree blobPair = pure . renderJSONDiff blobPair -renderJSONGraph :: (Applicative m, Functor syntax, Foldable syntax, ConstructorName syntax) => BlobPair -> Diff syntax Location Location -> m (Rendering.JSON.JSON "diffs" SomeJSON) -renderJSONGraph blobPair = pure . renderJSONAdjDiff blobPair . renderTreeGraph - -diffGraph :: (Traversable t, DiffEffects sig m) => t API.BlobPair -> m DiffTreeGraphResponse -diffGraph blobs = DiffTreeGraphResponse . V.fromList . toList <$> distributeFor (apiBlobPairToBlobPair <$> blobs) go +diffGraph :: (Traversable t, DiffEffects sig m) => t BlobPair -> m DiffTreeGraphResponse +diffGraph blobs = DiffTreeGraphResponse . V.fromList . toList <$> distributeFor blobs go where go :: (DiffEffects sig m) => BlobPair -> m DiffTreeFileGraph go blobPair = doDiff blobPair (const pure) render From 0d3a2856c8e49c8128d7c17af74d78fe74422ccb Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Fri, 15 Feb 2019 13:34:05 -0800 Subject: [PATCH 05/18] Fix up test due to breaking API change --- src/Semantic/CLI.hs | 18 +++++++-------- test/Rendering/TOC/Spec.hs | 8 +++---- test/fixtures/cli/diff-tree.toc.json | 27 +++++++++++++++-------- test/fixtures/cli/parse-tree.symbols.json | 15 ++++++++++--- 4 files changed, 43 insertions(+), 25 deletions(-) diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index 142a9bf4d..8a57195f2 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -60,12 +60,12 @@ diffCommand :: Mod CommandFields (Task.TaskEff Builder) diffCommand = command "diff" (info diffArgumentsParser (progDesc "Compute changes between paths")) where diffArgumentsParser = do - renderer <- flag (parseDiffBuilder DiffSExpression) (parseDiffBuilder DiffSExpression) (long "sexpression" <> help "Output s-expression diff tree (default)") - <|> flag' (parseDiffBuilder DiffJSONTree) (long "json" <> help "Output JSON diff trees") - <|> flag' (parseDiffBuilder DiffJSONGraph) (long "json-graph" <> help "Output JSON diff trees") - <|> flag' (diffSummaryBuilder JSON) (long "toc" <> help "Output JSON table of contents diff summary") - <|> flag' (parseDiffBuilder DiffDotGraph) (long "dot" <> help "Output the diff as a DOT graph") - <|> flag' (parseDiffBuilder DiffShow) (long "show" <> help "Output using the Show instance (debug only, format subject to change without notice)") + renderer <- flag (parseDiffBuilder DiffSExpression) (parseDiffBuilder DiffSExpression) (long "sexpression" <> help "Output s-expression diff tree (default)") + <|> flag' (parseDiffBuilder DiffJSONTree) (long "json" <> help "Output JSON diff trees") + <|> flag' (parseDiffBuilder DiffJSONGraph) (long "json-graph" <> help "Output JSON diff trees") + <|> flag' (diffSummaryBuilder JSON) (long "toc" <> help "Output JSON table of contents diff summary") + <|> flag' (parseDiffBuilder DiffDotGraph) (long "dot" <> help "Output the diff as a DOT graph") + <|> flag' (parseDiffBuilder DiffShow) (long "show" <> help "Output using the Show instance (debug only, format subject to change without notice)") filesOrStdin <- Right <$> some (Both <$> argument filePathReader (metavar "FILE_A") <*> argument filePathReader (metavar "FILE_B")) <|> pure (Left stdin) pure $ Task.readBlobPairs filesOrStdin >>= renderer @@ -77,9 +77,9 @@ parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate pa <|> flag' (parseTermBuilder TermJSONTree) (long "json" <> help "Output JSON parse trees") <|> flag' (parseTermBuilder TermJSONGraph) (long "json-graph" <> help "Output JSON adjacency list") <|> flag' parseSymbolsBuilder (long "symbols" <> help "Output JSON symbol list") - <|> flag' (parseTermBuilder TermDotGraph) (long "dot" <> help "Output DOT graph parse trees") - <|> flag' (parseTermBuilder TermShow) (long "show" <> help "Output using the Show instance (debug only, format subject to change without notice)") - <|> flag' (parseTermBuilder TermQuiet) (long "quiet" <> help "Don't produce output, but show timing stats") + <|> flag' (parseTermBuilder TermDotGraph) (long "dot" <> help "Output DOT graph parse trees") + <|> flag' (parseTermBuilder TermShow) (long "show" <> help "Output using the Show instance (debug only, format subject to change without notice)") + <|> flag' (parseTermBuilder TermQuiet) (long "quiet" <> help "Don't produce output, but show timing stats") filesOrStdin <- Right <$> some (argument filePathReader (metavar "FILES...")) <|> pure (Left stdin) pure $ Task.readBlobs filesOrStdin >>= renderer diff --git a/test/Rendering/TOC/Spec.hs b/test/Rendering/TOC/Spec.hs index 4630ef7ca..4f014f6d4 100644 --- a/test/Rendering/TOC/Spec.hs +++ b/test/Rendering/TOC/Spec.hs @@ -149,22 +149,22 @@ spec = parallel $ do it "produces JSON output" $ do blobs <- blobsForPaths (Both "ruby/toc/methods.A.rb" "ruby/toc/methods.B.rb") output <- runTaskOrDie (diffSummaryBuilder Format.JSON [blobs]) - runBuilder output `shouldBe` ("{\"changes\":{\"test/fixtures/ruby/toc/methods.A.rb -> test/fixtures/ruby/toc/methods.B.rb\":[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"category\":\"Method\",\"term\":\"self.foo\",\"changeType\":\"added\"},{\"span\":{\"start\":[4,1],\"end\":[6,4]},\"category\":\"Method\",\"term\":\"bar\",\"changeType\":\"modified\"},{\"span\":{\"start\":[4,1],\"end\":[5,4]},\"category\":\"Method\",\"term\":\"baz\",\"changeType\":\"removed\"}]},\"errors\":{}}\n" :: ByteString) + runBuilder output `shouldBe` ("{\"files\":[{\"path\":\"test/fixtures/ruby/toc/methods.A.rb -> test/fixtures/ruby/toc/methods.B.rb\",\"changes\":[{\"span\":{\"start\":{\"line\":1,\"column\":1},\"end\":{\"line\":2,\"column\":4}},\"category\":\"Method\",\"term\":\"self.foo\",\"changeType\":\"Added\"},{\"span\":{\"start\":{\"line\":4,\"column\":1},\"end\":{\"line\":6,\"column\":4}},\"category\":\"Method\",\"term\":\"bar\",\"changeType\":\"Modified\"},{\"span\":{\"start\":{\"line\":4,\"column\":1},\"end\":{\"line\":5,\"column\":4}},\"category\":\"Method\",\"term\":\"baz\",\"changeType\":\"Removed\"}],\"language\":\"Ruby\",\"errors\":[]}]}\n" :: ByteString) it "produces JSON output if there are parse errors" $ do blobs <- blobsForPaths (Both "ruby/toc/methods.A.rb" "ruby/toc/methods.X.rb") output <- runTaskOrDie (diffSummaryBuilder Format.JSON [blobs]) - runBuilder output `shouldBe` ("{\"changes\":{\"test/fixtures/ruby/toc/methods.A.rb -> test/fixtures/ruby/toc/methods.X.rb\":[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"category\":\"Method\",\"term\":\"bar\",\"changeType\":\"removed\"},{\"span\":{\"start\":[4,1],\"end\":[5,4]},\"category\":\"Method\",\"term\":\"baz\",\"changeType\":\"removed\"}]},\"errors\":{\"test/fixtures/ruby/toc/methods.A.rb -> test/fixtures/ruby/toc/methods.X.rb\":[{\"span\":{\"start\":[1,1],\"end\":[2,3]},\"error\":\"expected end of input nodes, but got ParseError\",\"language\":\"Ruby\"}]}}\n" :: ByteString) + runBuilder output `shouldBe` ("{\"files\":[{\"path\":\"test/fixtures/ruby/toc/methods.A.rb -> test/fixtures/ruby/toc/methods.X.rb\",\"changes\":[{\"span\":{\"start\":{\"line\":1,\"column\":1},\"end\":{\"line\":2,\"column\":4}},\"category\":\"Method\",\"term\":\"bar\",\"changeType\":\"Removed\"},{\"span\":{\"start\":{\"line\":4,\"column\":1},\"end\":{\"line\":5,\"column\":4}},\"category\":\"Method\",\"term\":\"baz\",\"changeType\":\"Removed\"}],\"language\":\"Ruby\",\"errors\":[{\"span\":{\"start\":{\"line\":1,\"column\":1},\"end\":{\"line\":2,\"column\":3}},\"error\":\"expected end of input nodes, but got ParseError\"}]}]}\n" :: ByteString) it "ignores anonymous functions" $ do blobs <- blobsForPaths (Both "ruby/toc/lambda.A.rb" "ruby/toc/lambda.B.rb") output <- runTaskOrDie (diffSummaryBuilder Format.JSON [blobs]) - runBuilder output `shouldBe` ("{\"changes\":{},\"errors\":{}}\n" :: ByteString) + runBuilder output `shouldBe` ("{\"files\":[{\"path\":\"test/fixtures/ruby/toc/lambda.A.rb -> test/fixtures/ruby/toc/lambda.B.rb\",\"changes\":[],\"language\":\"Ruby\",\"errors\":[]}]}\n" :: ByteString) it "summarizes Markdown headings" $ do blobs <- blobsForPaths (Both "markdown/toc/headings.A.md" "markdown/toc/headings.B.md") output <- runTaskOrDie (diffSummaryBuilder Format.JSON [blobs]) - runBuilder output `shouldBe` ("{\"changes\":{\"test/fixtures/markdown/toc/headings.A.md -> test/fixtures/markdown/toc/headings.B.md\":[{\"span\":{\"start\":[1,1],\"end\":[3,16]},\"category\":\"Heading 1\",\"term\":\"Introduction\",\"changeType\":\"removed\"},{\"span\":{\"start\":[5,1],\"end\":[7,4]},\"category\":\"Heading 2\",\"term\":\"Two\",\"changeType\":\"modified\"},{\"span\":{\"start\":[9,1],\"end\":[11,10]},\"category\":\"Heading 3\",\"term\":\"This heading is new\",\"changeType\":\"added\"},{\"span\":{\"start\":[13,1],\"end\":[14,4]},\"category\":\"Heading 1\",\"term\":\"Final\",\"changeType\":\"added\"}]},\"errors\":{}}\n" :: ByteString) + runBuilder output `shouldBe` ("{\"files\":[{\"path\":\"test/fixtures/markdown/toc/headings.A.md -> test/fixtures/markdown/toc/headings.B.md\",\"changes\":[{\"span\":{\"start\":{\"line\":1,\"column\":1},\"end\":{\"line\":3,\"column\":16}},\"category\":\"Heading 1\",\"term\":\"Introduction\",\"changeType\":\"Removed\"},{\"span\":{\"start\":{\"line\":5,\"column\":1},\"end\":{\"line\":7,\"column\":4}},\"category\":\"Heading 2\",\"term\":\"Two\",\"changeType\":\"Modified\"},{\"span\":{\"start\":{\"line\":9,\"column\":1},\"end\":{\"line\":11,\"column\":10}},\"category\":\"Heading 3\",\"term\":\"This heading is new\",\"changeType\":\"Added\"},{\"span\":{\"start\":{\"line\":13,\"column\":1},\"end\":{\"line\":14,\"column\":4}},\"category\":\"Heading 1\",\"term\":\"Final\",\"changeType\":\"Added\"}],\"language\":\"Markdown\",\"errors\":[]}]}\n" :: ByteString) type Diff' = Diff ListableSyntax (Maybe Declaration) (Maybe Declaration) diff --git a/test/fixtures/cli/diff-tree.toc.json b/test/fixtures/cli/diff-tree.toc.json index 01b42fe92..8a25277e5 100644 --- a/test/fixtures/cli/diff-tree.toc.json +++ b/test/fixtures/cli/diff-tree.toc.json @@ -1,18 +1,27 @@ { - "changes": + "files": [ { - "test/fixtures/ruby/corpus/method-declaration.A.rb -> test/fixtures/ruby/corpus/method-declaration.B.rb": [ + "path": "test/fixtures/ruby/corpus/method-declaration.A.rb -> test/fixtures/ruby/corpus/method-declaration.B.rb", + "changes": [ { "span": { - "start": [1, 1], - "end": [3, 4] + "start": + { + "line": 1, + "column": 1 + }, + "end": + { + "line": 3, + "column": 4 + } }, "category": "Method", "term": "bar", - "changeType": "modified" - }] - }, - "errors": - {} + "changeType": "Modified" + }], + "language": "Ruby", + "errors": [] + }] } diff --git a/test/fixtures/cli/parse-tree.symbols.json b/test/fixtures/cli/parse-tree.symbols.json index efec4b552..b133178e0 100644 --- a/test/fixtures/cli/parse-tree.symbols.json +++ b/test/fixtures/cli/parse-tree.symbols.json @@ -6,13 +6,22 @@ { "span": { - "start": [1, 1], - "end": [2, 4] + "start": + { + "line": 1, + "column": 1 + }, + "end": + { + "line": 2, + "column": 4 + } }, "kind": "Method", "symbol": "foo", "line": "def foo" }], - "language": "Ruby" + "language": "Ruby", + "errors": [] }] } From cbd83d5bb9c5a6120b04623e36eb2f49718a2b87 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Fri, 15 Feb 2019 13:34:17 -0800 Subject: [PATCH 06/18] This warrents a version bump --- semantic.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/semantic.cabal b/semantic.cabal index 9e794ab21..7edda6e2d 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -1,5 +1,5 @@ name: semantic -version: 0.5.0 +version: 0.6.0 synopsis: Framework and service for analyzing and diffing untrusted code. description: Please see README.md homepage: http://github.com/github/semantic#readme From 2378f97b22f17fe04c53b24b0d1198da952ac2ff Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Fri, 15 Feb 2019 14:05:36 -0800 Subject: [PATCH 07/18] Don't need this import --- src/Semantic/Api/Diffs.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Semantic/Api/Diffs.hs b/src/Semantic/Api/Diffs.hs index 88b7d61bc..d42e8e50b 100644 --- a/src/Semantic/Api/Diffs.hs +++ b/src/Semantic/Api/Diffs.hs @@ -35,7 +35,6 @@ import Rendering.JSON hiding (JSON) import qualified Rendering.JSON import Semantic.Api.Helpers import Semantic.Api.V1.CodeAnalysisPB hiding (Blob, BlobPair, Language(..)) -import qualified Semantic.Api.V1.CodeAnalysisPB as API import Semantic.Task as Task import Semantic.Telemetry as Stat import Serializing.Format hiding (JSON) From d5a1fa45d0204402ff7a2dcb9b50eef7d9fea425 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Fri, 15 Feb 2019 14:52:00 -0800 Subject: [PATCH 08/18] One more import --- src/Semantic/Api/TOCSummaries.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Semantic/Api/TOCSummaries.hs b/src/Semantic/Api/TOCSummaries.hs index 29f6abde3..2a3ba6504 100644 --- a/src/Semantic/Api/TOCSummaries.hs +++ b/src/Semantic/Api/TOCSummaries.hs @@ -15,7 +15,6 @@ import Rendering.TOC import Semantic.Api.Diffs import Semantic.Api.Helpers import Semantic.Api.V1.CodeAnalysisPB hiding (Blob, BlobPair) -import qualified Semantic.Api.V1.CodeAnalysisPB as API import Semantic.Task as Task import Serializing.Format From ec9113cc913af1a42607aa41d53e55cd88e8744c Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Tue, 19 Feb 2019 12:49:30 -0800 Subject: [PATCH 09/18] docs is part of this response now too --- test/fixtures/cli/parse-tree.symbols.json | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/test/fixtures/cli/parse-tree.symbols.json b/test/fixtures/cli/parse-tree.symbols.json index b133178e0..5f58f20f7 100644 --- a/test/fixtures/cli/parse-tree.symbols.json +++ b/test/fixtures/cli/parse-tree.symbols.json @@ -19,7 +19,8 @@ }, "kind": "Method", "symbol": "foo", - "line": "def foo" + "line": "def foo", + "docs": null }], "language": "Ruby", "errors": [] From f2116d9ed82f4d75aec6b7d0282069898b3bbcb6 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Tue, 19 Feb 2019 16:33:30 -0800 Subject: [PATCH 10/18] Let's call it 1.0! --- semantic.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/semantic.cabal b/semantic.cabal index 7edda6e2d..2d96f096d 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -1,5 +1,5 @@ name: semantic -version: 0.6.0 +version: 1.0.0 synopsis: Framework and service for analyzing and diffing untrusted code. description: Please see README.md homepage: http://github.com/github/semantic#readme From af321dfd23719bef5a2ac792dd2269aded5a63a9 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Wed, 20 Feb 2019 08:27:46 -0800 Subject: [PATCH 11/18] Revert "Let's call it 1.0!" This reverts commit ec8377ca30b15b29c49aec9ed5cb3811b7c07ff4. --- semantic.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/semantic.cabal b/semantic.cabal index 2d96f096d..7edda6e2d 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -1,5 +1,5 @@ name: semantic -version: 1.0.0 +version: 0.6.0 synopsis: Framework and service for analyzing and diffing untrusted code. description: Please see README.md homepage: http://github.com/github/semantic#readme From e12cea5e40996b8a1d0104e88876cc2a27a0b55e Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Wed, 20 Feb 2019 14:51:21 -0800 Subject: [PATCH 12/18] Whoops, got these backward --- src/Semantic/CLI.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index 4edc274cd..6f6f490e7 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -126,8 +126,8 @@ filePathReader :: ReadM File filePathReader = eitherReader parseFilePath where parseFilePath arg = case splitWhen (== ':') arg of - [a, b] | Just lang <- readMaybe a -> Right (File a lang) - | Just lang <- readMaybe b -> Right (File b lang) + [a, b] | Just lang <- readMaybe b -> Right (File a lang) + | Just lang <- readMaybe a -> Right (File b lang) [path] -> Right (File path (languageForFilePath path)) args -> Left ("cannot parse `" <> join args <> "`\nexpecting FILE:LANGUAGE or just FILE") From 69b523593fed11d4f2382c1e55b49f2f23e2711c Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Wed, 20 Feb 2019 15:41:51 -0800 Subject: [PATCH 13/18] Use parseLanguages --- src/Data/Language.hs | 30 +++++++++++++++++------------- src/Semantic/CLI.hs | 14 +++++++------- 2 files changed, 24 insertions(+), 20 deletions(-) diff --git a/src/Data/Language.hs b/src/Data/Language.hs index 9a0a101c2..eba11a7d2 100644 --- a/src/Data/Language.hs +++ b/src/Data/Language.hs @@ -3,6 +3,7 @@ module Data.Language ( Language (..) , SLanguage (..) , extensionsForLanguage + , parseLanguage , knownLanguage , languageForFilePath , languageForType @@ -80,20 +81,23 @@ instance Finite Language where go x = (fromString (fmap toUpper (show x)), fromEnum x) instance FromJSON Language where - parseJSON = withText "Language" $ \l -> pure $ case T.toLower l of - "go" -> Go - "haskell" -> Haskell - "java" -> Java - "javascript" -> JavaScript - "json" -> JSON - "jsx" -> JSX - "markdown" -> Markdown - "python" -> Python - "ruby" -> Ruby - "typescript" -> TypeScript - "php" -> PHP - _ -> Unknown + parseJSON = withText "Language" $ \l -> + pure $ fromMaybe Unknown (parseLanguage l) +parseLanguage :: Text -> Maybe Language +parseLanguage l = case T.toLower l of + "go" -> Just Go + "haskell" -> Just Haskell + "java" -> Just Java + "javascript" -> Just JavaScript + "json" -> Just JSON + "jsx" -> Just JSX + "markdown" -> Just Markdown + "python" -> Just Python + "ruby" -> Just Ruby + "typescript" -> Just TypeScript + "php" -> Just PHP + _ -> Nothing -- | Predicate failing on 'Unknown' and passing in all other cases. knownLanguage :: Language -> Bool diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index 6f6f490e7..55f2e79f0 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -3,11 +3,12 @@ module Semantic.CLI (main) where import Control.Exception as Exc (displayException) import Data.File -import Data.Language (languageForFilePath) +import Data.Handle +import Data.Language (languageForFilePath, parseLanguage) import Data.List (intercalate, uncons) import Data.List.Split (splitWhen) -import Data.Handle import Data.Project +import qualified Data.Text as T import Options.Applicative hiding (style) import Prologue import Semantic.Api hiding (File) @@ -15,14 +16,13 @@ import qualified Semantic.AST as AST import Semantic.Config import qualified Semantic.Graph as Graph import qualified Semantic.Task as Task -import qualified Semantic.Telemetry.Log as Log import Semantic.Task.Files import Semantic.Telemetry +import qualified Semantic.Telemetry.Log as Log import Semantic.Version +import Serializing.Format hiding (Options) import System.Exit (die) import System.FilePath -import Serializing.Format hiding (Options) -import Text.Read main :: IO () main = do @@ -126,8 +126,8 @@ filePathReader :: ReadM File filePathReader = eitherReader parseFilePath where parseFilePath arg = case splitWhen (== ':') arg of - [a, b] | Just lang <- readMaybe b -> Right (File a lang) - | Just lang <- readMaybe a -> Right (File b lang) + [a, b] | Just lang <- parseLanguage (T.pack b) -> Right (File a lang) + | Just lang <- parseLanguage (T.pack a) -> Right (File b lang) [path] -> Right (File path (languageForFilePath path)) args -> Left ("cannot parse `" <> join args <> "`\nexpecting FILE:LANGUAGE or just FILE") From 53a068a71b5da68dbf8437ca20617a67592f6247 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Wed, 20 Feb 2019 15:59:36 -0800 Subject: [PATCH 14/18] Show entire arg --- src/Semantic/CLI.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index 55f2e79f0..fb6e947a4 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -129,7 +129,7 @@ filePathReader = eitherReader parseFilePath [a, b] | Just lang <- parseLanguage (T.pack b) -> Right (File a lang) | Just lang <- parseLanguage (T.pack a) -> Right (File b lang) [path] -> Right (File path (languageForFilePath path)) - args -> Left ("cannot parse `" <> join args <> "`\nexpecting FILE:LANGUAGE or just FILE") + args -> Left ("cannot parse `" <> arg <> "`\nexpecting FILE:LANGUAGE or just FILE") options :: Eq a => [(String, a)] -> Mod OptionFields a -> Parser a options options fields = option (optionsReader options) (fields <> showDefaultWith (findOption options) <> metavar (intercalate "|" (fmap fst options))) From b09e0c27bb78c9e01ad86b06c73745545c3d2a18 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Wed, 20 Feb 2019 16:48:21 -0800 Subject: [PATCH 15/18] Dont need args --- src/Semantic/CLI.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index fb6e947a4..95ffef027 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -129,7 +129,7 @@ filePathReader = eitherReader parseFilePath [a, b] | Just lang <- parseLanguage (T.pack b) -> Right (File a lang) | Just lang <- parseLanguage (T.pack a) -> Right (File b lang) [path] -> Right (File path (languageForFilePath path)) - args -> Left ("cannot parse `" <> arg <> "`\nexpecting FILE:LANGUAGE or just FILE") + _ -> Left ("cannot parse `" <> arg <> "`\nexpecting FILE:LANGUAGE or just FILE") options :: Eq a => [(String, a)] -> Mod OptionFields a -> Parser a options options fields = option (optionsReader options) (fields <> showDefaultWith (findOption options) <> metavar (intercalate "|" (fmap fst options))) From 59efdf3979f9782b53ff0254fe51905158eee3b0 Mon Sep 17 00:00:00 2001 From: Douglas Creager Date: Thu, 21 Feb 2019 08:36:06 -0500 Subject: [PATCH 16/18] Include license information in our Docker images This includes a third-party notice file summarizing everything, and a copy of all of the per-package license files as generated by licensed. --- notices/THIRD_PARTY_NOTICE.md | 245 ++++++++++++++++++++++++++++++++++ 1 file changed, 245 insertions(+) create mode 100644 notices/THIRD_PARTY_NOTICE.md diff --git a/notices/THIRD_PARTY_NOTICE.md b/notices/THIRD_PARTY_NOTICE.md new file mode 100644 index 000000000..d1372863a --- /dev/null +++ b/notices/THIRD_PARTY_NOTICE.md @@ -0,0 +1,245 @@ +# Third Party Notices and Information + +Container images built with this project include third party materials; see +below for license and other copyright information. + +Certain open source code is available in container images, or online as noted +below, or you may send a request for source code including identification of the +container, the open source component name, and version number, to: +`opensource@github.com`. + +Notwithstanding any other terms, you may reverse engineer this software to the +extent required to debug changes to any libraries licensed under the GNU Lesser +General Public License for your own use. + +## Debian packages + +License and other copyright information for each package is included in the +image at `/usr/share/doc/{package}/copyright`. + +Source for each package is available at +`https://packages.debian.org/source/{package}`. + +## Haskell packages + +License and other copyright information for each package is included in the +image at `/usr/share/doc/licenses/cabal/{package}.txt`. + +Additional information for each package is available at +`https://hackage.haskell.org/package/{package}`. + +## Docker + +The docker binaries are licensed under Apache-2.0. `NOTICE`: + +> Docker +> Copyright 2012-2017 Docker, Inc. +> +> This product includes software developed at Docker, Inc. (https://www.docker.com). +> +> This product contains software (https://github.com/kr/pty) developed +> by Keith Rarick, licensed under the MIT License. +> +> The following is courtesy of our legal counsel: +> +> +> Use and transfer of Docker may be subject to certain restrictions by the +> United States and other governments. +> It is your responsibility to ensure that your use and/or transfer does not +> violate applicable laws. +> +> For more information, please see https://www.bis.doc.gov +> +> See also https://www.apache.org/dev/crypto.html and/or seek legal counsel. + +`LICENSE`: +> Apache License +> Version 2.0, January 2004 +> https://www.apache.org/licenses/ +> +> TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION +> +> 1. Definitions. +> +> "License" shall mean the terms and conditions for use, reproduction, +> and distribution as defined by Sections 1 through 9 of this document. +> +> "Licensor" shall mean the copyright owner or entity authorized by +> the copyright owner that is granting the License. +> +> "Legal Entity" shall mean the union of the acting entity and all +> other entities that control, are controlled by, or are under common +> control with that entity. For the purposes of this definition, +> "control" means (i) the power, direct or indirect, to cause the +> direction or management of such entity, whether by contract or +> otherwise, or (ii) ownership of fifty percent (50%) or more of the +> outstanding shares, or (iii) beneficial ownership of such entity. +> +> "You" (or "Your") shall mean an individual or Legal Entity +> exercising permissions granted by this License. +> +> "Source" form shall mean the preferred form for making modifications, +> including but not limited to software source code, documentation +> source, and configuration files. +> +> "Object" form shall mean any form resulting from mechanical +> transformation or translation of a Source form, including but +> not limited to compiled object code, generated documentation, +> and conversions to other media types. +> +> "Work" shall mean the work of authorship, whether in Source or +> Object form, made available under the License, as indicated by a +> copyright notice that is included in or attached to the work +> (an example is provided in the Appendix below). +> +> "Derivative Works" shall mean any work, whether in Source or Object +> form, that is based on (or derived from) the Work and for which the +> editorial revisions, annotations, elaborations, or other modifications +> represent, as a whole, an original work of authorship. For the purposes +> of this License, Derivative Works shall not include works that remain +> separable from, or merely link (or bind by name) to the interfaces of, +> the Work and Derivative Works thereof. +> +> "Contribution" shall mean any work of authorship, including +> the original version of the Work and any modifications or additions +> to that Work or Derivative Works thereof, that is intentionally +> submitted to Licensor for inclusion in the Work by the copyright owner +> or by an individual or Legal Entity authorized to submit on behalf of +> the copyright owner. For the purposes of this definition, "submitted" +> means any form of electronic, verbal, or written communication sent +> to the Licensor or its representatives, including but not limited to +> communication on electronic mailing lists, source code control systems, +> and issue tracking systems that are managed by, or on behalf of, the +> Licensor for the purpose of discussing and improving the Work, but +> excluding communication that is conspicuously marked or otherwise +> designated in writing by the copyright owner as "Not a Contribution." +> +> "Contributor" shall mean Licensor and any individual or Legal Entity +> on behalf of whom a Contribution has been received by Licensor and +> subsequently incorporated within the Work. +> +> 2. Grant of Copyright License. Subject to the terms and conditions of +> this License, each Contributor hereby grants to You a perpetual, +> worldwide, non-exclusive, no-charge, royalty-free, irrevocable +> copyright license to reproduce, prepare Derivative Works of, +> publicly display, publicly perform, sublicense, and distribute the +> Work and such Derivative Works in Source or Object form. +> +> 3. Grant of Patent License. Subject to the terms and conditions of +> this License, each Contributor hereby grants to You a perpetual, +> worldwide, non-exclusive, no-charge, royalty-free, irrevocable +> (except as stated in this section) patent license to make, have made, +> use, offer to sell, sell, import, and otherwise transfer the Work, +> where such license applies only to those patent claims licensable +> by such Contributor that are necessarily infringed by their +> Contribution(s) alone or by combination of their Contribution(s) +> with the Work to which such Contribution(s) was submitted. If You +> institute patent litigation against any entity (including a +> cross-claim or counterclaim in a lawsuit) alleging that the Work +> or a Contribution incorporated within the Work constitutes direct +> or contributory patent infringement, then any patent licenses +> granted to You under this License for that Work shall terminate +> as of the date such litigation is filed. +> +> 4. Redistribution. You may reproduce and distribute copies of the +> Work or Derivative Works thereof in any medium, with or without +> modifications, and in Source or Object form, provided that You +> meet the following conditions: +> +> (a) You must give any other recipients of the Work or +> Derivative Works a copy of this License; and +> +> (b) You must cause any modified files to carry prominent notices +> stating that You changed the files; and +> +> (c) You must retain, in the Source form of any Derivative Works +> that You distribute, all copyright, patent, trademark, and +> attribution notices from the Source form of the Work, +> excluding those notices that do not pertain to any part of +> the Derivative Works; and +> +> (d) If the Work includes a "NOTICE" text file as part of its +> distribution, then any Derivative Works that You distribute must +> include a readable copy of the attribution notices contained +> within such NOTICE file, excluding those notices that do not +> pertain to any part of the Derivative Works, in at least one +> of the following places: within a NOTICE text file distributed +> as part of the Derivative Works; within the Source form or +> documentation, if provided along with the Derivative Works; or, +> within a display generated by the Derivative Works, if and +> wherever such third-party notices normally appear. The contents +> of the NOTICE file are for informational purposes only and +> do not modify the License. You may add Your own attribution +> notices within Derivative Works that You distribute, alongside +> or as an addendum to the NOTICE text from the Work, provided +> that such additional attribution notices cannot be construed +> as modifying the License. +> +> You may add Your own copyright statement to Your modifications and +> may provide additional or different license terms and conditions +> for use, reproduction, or distribution of Your modifications, or +> for any such Derivative Works as a whole, provided Your use, +> reproduction, and distribution of the Work otherwise complies with +> the conditions stated in this License. +> +> 5. Submission of Contributions. Unless You explicitly state otherwise, +> any Contribution intentionally submitted for inclusion in the Work +> by You to the Licensor shall be under the terms and conditions of +> this License, without any additional terms or conditions. +> Notwithstanding the above, nothing herein shall supersede or modify +> the terms of any separate license agreement you may have executed +> with Licensor regarding such Contributions. +> +> 6. Trademarks. This License does not grant permission to use the trade +> names, trademarks, service marks, or product names of the Licensor, +> except as required for reasonable and customary use in describing the +> origin of the Work and reproducing the content of the NOTICE file. +> +> 7. Disclaimer of Warranty. Unless required by applicable law or +> agreed to in writing, Licensor provides the Work (and each +> Contributor provides its Contributions) on an "AS IS" BASIS, +> WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or +> implied, including, without limitation, any warranties or conditions +> of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A +> PARTICULAR PURPOSE. You are solely responsible for determining the +> appropriateness of using or redistributing the Work and assume any +> risks associated with Your exercise of permissions under this License. +> +> 8. Limitation of Liability. In no event and under no legal theory, +> whether in tort (including negligence), contract, or otherwise, +> unless required by applicable law (such as deliberate and grossly +> negligent acts) or agreed to in writing, shall any Contributor be +> liable to You for damages, including any direct, indirect, special, +> incidental, or consequential damages of any character arising as a +> result of this License or out of the use or inability to use the +> Work (including but not limited to damages for loss of goodwill, +> work stoppage, computer failure or malfunction, or any and all +> other commercial damages or losses), even if such Contributor +> has been advised of the possibility of such damages. +> +> 9. Accepting Warranty or Additional Liability. While redistributing +> the Work or Derivative Works thereof, You may choose to offer, +> and charge a fee for, acceptance of support, warranty, indemnity, +> or other liability obligations and/or rights consistent with this +> License. However, in accepting such obligations, You may act only +> on Your own behalf and on Your sole responsibility, not on behalf +> of any other Contributor, and only if You agree to indemnify, +> defend, and hold each Contributor harmless for any liability +> incurred by, or claims asserted against, such Contributor by reason +> of your accepting any such warranty or additional liability. +> +> END OF TERMS AND CONDITIONS +> +> Copyright 2013-2018 Docker, Inc. +> +> Licensed under the Apache License, Version 2.0 (the "License"); +> you may not use this file except in compliance with the License. +> You may obtain a copy of the License at +> +> https://www.apache.org/licenses/LICENSE-2.0 +> +> Unless required by applicable law or agreed to in writing, software +> distributed under the License is distributed on an "AS IS" BASIS, +> WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +> See the License for the specific language governing permissions and +> limitations under the License. From 7a7512d1d4a7e8b331e0b542bb6a460b766410a2 Mon Sep 17 00:00:00 2001 From: Douglas Creager Date: Thu, 21 Feb 2019 08:43:53 -0500 Subject: [PATCH 17/18] Mention that source is available at Hackage --- notices/THIRD_PARTY_NOTICE.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/notices/THIRD_PARTY_NOTICE.md b/notices/THIRD_PARTY_NOTICE.md index d1372863a..bf51cceb8 100644 --- a/notices/THIRD_PARTY_NOTICE.md +++ b/notices/THIRD_PARTY_NOTICE.md @@ -25,7 +25,7 @@ Source for each package is available at License and other copyright information for each package is included in the image at `/usr/share/doc/licenses/cabal/{package}.txt`. -Additional information for each package is available at +Source and additional information for each package is available at `https://hackage.haskell.org/package/{package}`. ## Docker From 9cdaf7af29350a90d9bcf0c218f1d37986579ec9 Mon Sep 17 00:00:00 2001 From: Douglas Creager Date: Thu, 21 Feb 2019 18:42:50 -0500 Subject: [PATCH 18/18] Remove docker section from third-party notice Our images don't have the Docker executables installed inside of them, so we don't need to mention them in the third-party notice. --- notices/THIRD_PARTY_NOTICE.md | 216 ---------------------------------- 1 file changed, 216 deletions(-) diff --git a/notices/THIRD_PARTY_NOTICE.md b/notices/THIRD_PARTY_NOTICE.md index bf51cceb8..164a098cb 100644 --- a/notices/THIRD_PARTY_NOTICE.md +++ b/notices/THIRD_PARTY_NOTICE.md @@ -27,219 +27,3 @@ image at `/usr/share/doc/licenses/cabal/{package}.txt`. Source and additional information for each package is available at `https://hackage.haskell.org/package/{package}`. - -## Docker - -The docker binaries are licensed under Apache-2.0. `NOTICE`: - -> Docker -> Copyright 2012-2017 Docker, Inc. -> -> This product includes software developed at Docker, Inc. (https://www.docker.com). -> -> This product contains software (https://github.com/kr/pty) developed -> by Keith Rarick, licensed under the MIT License. -> -> The following is courtesy of our legal counsel: -> -> -> Use and transfer of Docker may be subject to certain restrictions by the -> United States and other governments. -> It is your responsibility to ensure that your use and/or transfer does not -> violate applicable laws. -> -> For more information, please see https://www.bis.doc.gov -> -> See also https://www.apache.org/dev/crypto.html and/or seek legal counsel. - -`LICENSE`: -> Apache License -> Version 2.0, January 2004 -> https://www.apache.org/licenses/ -> -> TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION -> -> 1. Definitions. -> -> "License" shall mean the terms and conditions for use, reproduction, -> and distribution as defined by Sections 1 through 9 of this document. -> -> "Licensor" shall mean the copyright owner or entity authorized by -> the copyright owner that is granting the License. -> -> "Legal Entity" shall mean the union of the acting entity and all -> other entities that control, are controlled by, or are under common -> control with that entity. For the purposes of this definition, -> "control" means (i) the power, direct or indirect, to cause the -> direction or management of such entity, whether by contract or -> otherwise, or (ii) ownership of fifty percent (50%) or more of the -> outstanding shares, or (iii) beneficial ownership of such entity. -> -> "You" (or "Your") shall mean an individual or Legal Entity -> exercising permissions granted by this License. -> -> "Source" form shall mean the preferred form for making modifications, -> including but not limited to software source code, documentation -> source, and configuration files. -> -> "Object" form shall mean any form resulting from mechanical -> transformation or translation of a Source form, including but -> not limited to compiled object code, generated documentation, -> and conversions to other media types. -> -> "Work" shall mean the work of authorship, whether in Source or -> Object form, made available under the License, as indicated by a -> copyright notice that is included in or attached to the work -> (an example is provided in the Appendix below). -> -> "Derivative Works" shall mean any work, whether in Source or Object -> form, that is based on (or derived from) the Work and for which the -> editorial revisions, annotations, elaborations, or other modifications -> represent, as a whole, an original work of authorship. For the purposes -> of this License, Derivative Works shall not include works that remain -> separable from, or merely link (or bind by name) to the interfaces of, -> the Work and Derivative Works thereof. -> -> "Contribution" shall mean any work of authorship, including -> the original version of the Work and any modifications or additions -> to that Work or Derivative Works thereof, that is intentionally -> submitted to Licensor for inclusion in the Work by the copyright owner -> or by an individual or Legal Entity authorized to submit on behalf of -> the copyright owner. For the purposes of this definition, "submitted" -> means any form of electronic, verbal, or written communication sent -> to the Licensor or its representatives, including but not limited to -> communication on electronic mailing lists, source code control systems, -> and issue tracking systems that are managed by, or on behalf of, the -> Licensor for the purpose of discussing and improving the Work, but -> excluding communication that is conspicuously marked or otherwise -> designated in writing by the copyright owner as "Not a Contribution." -> -> "Contributor" shall mean Licensor and any individual or Legal Entity -> on behalf of whom a Contribution has been received by Licensor and -> subsequently incorporated within the Work. -> -> 2. Grant of Copyright License. Subject to the terms and conditions of -> this License, each Contributor hereby grants to You a perpetual, -> worldwide, non-exclusive, no-charge, royalty-free, irrevocable -> copyright license to reproduce, prepare Derivative Works of, -> publicly display, publicly perform, sublicense, and distribute the -> Work and such Derivative Works in Source or Object form. -> -> 3. Grant of Patent License. Subject to the terms and conditions of -> this License, each Contributor hereby grants to You a perpetual, -> worldwide, non-exclusive, no-charge, royalty-free, irrevocable -> (except as stated in this section) patent license to make, have made, -> use, offer to sell, sell, import, and otherwise transfer the Work, -> where such license applies only to those patent claims licensable -> by such Contributor that are necessarily infringed by their -> Contribution(s) alone or by combination of their Contribution(s) -> with the Work to which such Contribution(s) was submitted. If You -> institute patent litigation against any entity (including a -> cross-claim or counterclaim in a lawsuit) alleging that the Work -> or a Contribution incorporated within the Work constitutes direct -> or contributory patent infringement, then any patent licenses -> granted to You under this License for that Work shall terminate -> as of the date such litigation is filed. -> -> 4. Redistribution. You may reproduce and distribute copies of the -> Work or Derivative Works thereof in any medium, with or without -> modifications, and in Source or Object form, provided that You -> meet the following conditions: -> -> (a) You must give any other recipients of the Work or -> Derivative Works a copy of this License; and -> -> (b) You must cause any modified files to carry prominent notices -> stating that You changed the files; and -> -> (c) You must retain, in the Source form of any Derivative Works -> that You distribute, all copyright, patent, trademark, and -> attribution notices from the Source form of the Work, -> excluding those notices that do not pertain to any part of -> the Derivative Works; and -> -> (d) If the Work includes a "NOTICE" text file as part of its -> distribution, then any Derivative Works that You distribute must -> include a readable copy of the attribution notices contained -> within such NOTICE file, excluding those notices that do not -> pertain to any part of the Derivative Works, in at least one -> of the following places: within a NOTICE text file distributed -> as part of the Derivative Works; within the Source form or -> documentation, if provided along with the Derivative Works; or, -> within a display generated by the Derivative Works, if and -> wherever such third-party notices normally appear. The contents -> of the NOTICE file are for informational purposes only and -> do not modify the License. You may add Your own attribution -> notices within Derivative Works that You distribute, alongside -> or as an addendum to the NOTICE text from the Work, provided -> that such additional attribution notices cannot be construed -> as modifying the License. -> -> You may add Your own copyright statement to Your modifications and -> may provide additional or different license terms and conditions -> for use, reproduction, or distribution of Your modifications, or -> for any such Derivative Works as a whole, provided Your use, -> reproduction, and distribution of the Work otherwise complies with -> the conditions stated in this License. -> -> 5. Submission of Contributions. Unless You explicitly state otherwise, -> any Contribution intentionally submitted for inclusion in the Work -> by You to the Licensor shall be under the terms and conditions of -> this License, without any additional terms or conditions. -> Notwithstanding the above, nothing herein shall supersede or modify -> the terms of any separate license agreement you may have executed -> with Licensor regarding such Contributions. -> -> 6. Trademarks. This License does not grant permission to use the trade -> names, trademarks, service marks, or product names of the Licensor, -> except as required for reasonable and customary use in describing the -> origin of the Work and reproducing the content of the NOTICE file. -> -> 7. Disclaimer of Warranty. Unless required by applicable law or -> agreed to in writing, Licensor provides the Work (and each -> Contributor provides its Contributions) on an "AS IS" BASIS, -> WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or -> implied, including, without limitation, any warranties or conditions -> of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A -> PARTICULAR PURPOSE. You are solely responsible for determining the -> appropriateness of using or redistributing the Work and assume any -> risks associated with Your exercise of permissions under this License. -> -> 8. Limitation of Liability. In no event and under no legal theory, -> whether in tort (including negligence), contract, or otherwise, -> unless required by applicable law (such as deliberate and grossly -> negligent acts) or agreed to in writing, shall any Contributor be -> liable to You for damages, including any direct, indirect, special, -> incidental, or consequential damages of any character arising as a -> result of this License or out of the use or inability to use the -> Work (including but not limited to damages for loss of goodwill, -> work stoppage, computer failure or malfunction, or any and all -> other commercial damages or losses), even if such Contributor -> has been advised of the possibility of such damages. -> -> 9. Accepting Warranty or Additional Liability. While redistributing -> the Work or Derivative Works thereof, You may choose to offer, -> and charge a fee for, acceptance of support, warranty, indemnity, -> or other liability obligations and/or rights consistent with this -> License. However, in accepting such obligations, You may act only -> on Your own behalf and on Your sole responsibility, not on behalf -> of any other Contributor, and only if You agree to indemnify, -> defend, and hold each Contributor harmless for any liability -> incurred by, or claims asserted against, such Contributor by reason -> of your accepting any such warranty or additional liability. -> -> END OF TERMS AND CONDITIONS -> -> Copyright 2013-2018 Docker, Inc. -> -> Licensed under the Apache License, Version 2.0 (the "License"); -> you may not use this file except in compliance with the License. -> You may obtain a copy of the License at -> -> https://www.apache.org/licenses/LICENSE-2.0 -> -> Unless required by applicable law or agreed to in writing, software -> distributed under the License is distributed on an "AS IS" BASIS, -> WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -> See the License for the specific language governing permissions and -> limitations under the License.