From acb35a58690d9ca2499af439cb774558c7fb7126 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Fri, 28 Jul 2017 11:11:30 -0400 Subject: [PATCH 1/4] Stub in a module for an output typeclass. --- semantic-diff.cabal | 1 + src/Data/Output.hs | 1 + 2 files changed, 2 insertions(+) create mode 100644 src/Data/Output.hs diff --git a/semantic-diff.cabal b/semantic-diff.cabal index 64a8b8a39..9654b5642 100644 --- a/semantic-diff.cabal +++ b/semantic-diff.cabal @@ -24,6 +24,7 @@ library , Data.Functor.Listable , Data.Mergeable , Data.Mergeable.Generic + , Data.Output , Data.Range , Data.Record , Data.Source diff --git a/src/Data/Output.hs b/src/Data/Output.hs new file mode 100644 index 000000000..b663fbd57 --- /dev/null +++ b/src/Data/Output.hs @@ -0,0 +1 @@ +module Data.Output where From ab2c1a7cd3b5d73ff66d50e8ec07a519ae2c734f Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Fri, 28 Jul 2017 11:12:04 -0400 Subject: [PATCH 2/4] Define an Output typeclass. --- src/Data/Output.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/Data/Output.hs b/src/Data/Output.hs index b663fbd57..19307c4d8 100644 --- a/src/Data/Output.hs +++ b/src/Data/Output.hs @@ -1 +1,6 @@ module Data.Output where + +import Prologue + +class Monoid o => Output o where + toOutput :: o -> ByteString From 5da9f90532a87c6b00ff2d23a7dfe40c4adf03a9 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Fri, 28 Jul 2017 11:21:21 -0400 Subject: [PATCH 3/4] Define an Output instance for ByteString. --- src/Data/Output.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Data/Output.hs b/src/Data/Output.hs index 19307c4d8..9ce22da9b 100644 --- a/src/Data/Output.hs +++ b/src/Data/Output.hs @@ -4,3 +4,6 @@ import Prologue class Monoid o => Output o where toOutput :: o -> ByteString + +instance Output ByteString where + toOutput s = s From 3646ab2b1502eb715c676832ba5b3a48c9682fef Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Fri, 28 Jul 2017 11:23:55 -0400 Subject: [PATCH 4/4] Renderers produce Output. --- src/Renderer.hs | 3 ++- src/Renderer/JSON.hs | 12 +++++++----- src/Renderer/Patch.hs | 5 +++-- src/Renderer/TOC.hs | 8 +++++--- src/Semantic.hs | 9 +++++---- test/TOCSpec.hs | 7 ++++--- 6 files changed, 26 insertions(+), 18 deletions(-) diff --git a/src/Renderer.hs b/src/Renderer.hs index ca691a852..867be08f5 100644 --- a/src/Renderer.hs +++ b/src/Renderer.hs @@ -20,6 +20,7 @@ module Renderer import Data.Aeson (Value, (.=)) import qualified Data.Map as Map +import Data.Output import Data.Syntax.Algebra (RAlgebra) import Diff (SyntaxDiff) import Info (DefaultFields) @@ -66,7 +67,7 @@ deriving instance Show (TermRenderer output) -- -- This type abstracts the type indices of 'DiffRenderer' and 'TermRenderer' s.t. multiple renderers can be present in a single list, alternation, etc., while retaining the ability to render and serialize. (Without 'SomeRenderer', the different output types of individual term/diff renderers prevent them from being used in a homogeneously typed setting.) data SomeRenderer f where - SomeRenderer :: (Monoid output, StringConv output ByteString, Show (f output)) => f output -> SomeRenderer f + SomeRenderer :: (Output output, Show (f output)) => f output -> SomeRenderer f deriving instance Show (SomeRenderer f) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 92b9b3a35..28b0ba7f1 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -10,14 +10,16 @@ import Data.Aeson (ToJSON, toJSON, encode, object, (.=)) import Data.Aeson as A hiding (json) import Data.Bifunctor.Join import Data.Blob +import Data.ByteString.Lazy (toStrict) import Data.Functor.Both (Both) import qualified Data.Map as Map +import Data.Output import Data.Record import Data.Union import Info import Language import Patch -import Prologue hiding ((++)) +import Prologue hiding ((++), toStrict) import Syntax as S -- @@ -32,8 +34,8 @@ renderJSONDiff blobs diff = Map.fromList , ("paths", toJSON (blobPath <$> toList blobs)) ] -instance StringConv (Map Text Value) ByteString where - strConv _ = toS . (<> "\n") . encode +instance Output (Map Text Value) where + toOutput = toStrict . (<> "\n") . encode instance ToJSON a => ToJSONFields (Join (,) a) where toJSONFields (Join (a, b)) = [ "before" .= a, "after" .= b ] @@ -117,8 +119,8 @@ data File a = File { filePath :: FilePath, fileLanguage :: Maybe Language, fileC instance ToJSON a => ToJSON (File a) where toJSON File{..} = object [ "filePath" .= filePath, "language" .= fileLanguage, "programNode" .= fileContent ] -instance StringConv [Value] ByteString where - strConv _ = toS . (<> "\n") . encode +instance Output [Value] where + toOutput = toStrict . (<> "\n") . encode renderJSONTerm :: ToJSON a => Blob -> a -> [Value] renderJSONTerm Blob{..} = pure . toJSON . File blobPath blobLanguage diff --git a/src/Renderer/Patch.hs b/src/Renderer/Patch.hs index 65d96948d..17bc844b7 100644 --- a/src/Renderer/Patch.hs +++ b/src/Renderer/Patch.hs @@ -13,6 +13,7 @@ import Data.Blob import qualified Data.ByteString.Char8 as ByteString import Data.Functor.Both as Both import Data.List (span, unzip) +import Data.Output import Data.Range import Data.Record import Data.Source @@ -40,8 +41,8 @@ instance Monoid File where mempty = File mempty mappend (File a) (File b) = File (a <> "\n" <> b) -instance StringConv File ByteString where - strConv _ = unFile +instance Output File where + toOutput = unFile -- | A hunk in a patch, including the offset, changes, and context. diff --git a/src/Renderer/TOC.hs b/src/Renderer/TOC.hs index fb884f98c..d714a3983 100644 --- a/src/Renderer/TOC.hs +++ b/src/Renderer/TOC.hs @@ -20,10 +20,12 @@ module Renderer.TOC import Data.Aeson import Data.Align (crosswalk) import Data.Blob +import Data.ByteString.Lazy (toStrict) import Data.Functor.Both hiding (fst, snd) import qualified Data.Functor.Both as Both import Data.Functor.Listable import Data.List.NonEmpty (nonEmpty) +import Data.Output import Data.Record import Data.Source as Source import Data.Text (toLower) @@ -35,7 +37,7 @@ import Diff import Info import Language import Patch -import Prologue +import Prologue hiding (toStrict) import qualified Data.List as List import qualified Data.Map as Map hiding (null) import Syntax as S @@ -52,8 +54,8 @@ instance Monoid Summaries where mempty = Summaries mempty mempty mappend (Summaries c1 e1) (Summaries c2 e2) = Summaries (Map.unionWith (<>) c1 c2) (Map.unionWith (<>) e1 e2) -instance StringConv Summaries ByteString where - strConv _ = toS . (<> "\n") . encode +instance Output Summaries where + toOutput = toStrict . (<> "\n") . encode instance ToJSON Summaries where toJSON Summaries{..} = object [ "changes" .= changes, "errors" .= errors ] diff --git a/src/Semantic.hs b/src/Semantic.hs index bbd3dfbbe..2275cb35a 100644 --- a/src/Semantic.hs +++ b/src/Semantic.hs @@ -12,6 +12,7 @@ import Data.Align.Generic (GAlign) import Data.Blob import Data.Functor.Both as Both import Data.Functor.Classes (Eq1, Show1) +import Data.Output import Data.Record import qualified Data.Syntax.Declaration as Declaration import Data.Union @@ -36,8 +37,8 @@ import Term -- - Built in concurrency where appropriate. -- - Easy to consume this interface from other application (e.g a cmdline or web server app). -parseBlobs :: (Monoid output, StringConv output ByteString) => TermRenderer output -> [Blob] -> Task ByteString -parseBlobs renderer = fmap toS . distributeFoldMap (parseBlob renderer) . filter blobExists +parseBlobs :: Output output => TermRenderer output -> [Blob] -> Task ByteString +parseBlobs renderer = fmap toOutput . distributeFoldMap (parseBlob renderer) . filter blobExists -- | A task to parse a 'Blob' and render the resulting 'Term'. parseBlob :: TermRenderer output -> Blob -> Task output @@ -61,8 +62,8 @@ parseBlob renderer blob@Blob{..} = case (renderer, blobLanguage) of -diffBlobPairs :: (Monoid output, StringConv output ByteString) => DiffRenderer output -> [Both Blob] -> Task ByteString -diffBlobPairs renderer = fmap toS . distributeFoldMap (diffBlobPair renderer) . filter (any blobExists) +diffBlobPairs :: Output output => DiffRenderer output -> [Both Blob] -> Task ByteString +diffBlobPairs renderer = fmap toOutput . distributeFoldMap (diffBlobPair renderer) . filter (any blobExists) -- | A task to parse a pair of 'Blob's, diff them, and render the 'Diff'. diffBlobPair :: DiffRenderer output -> Both Blob -> Task output diff --git a/test/TOCSpec.hs b/test/TOCSpec.hs index 9d43e370b..4e990f935 100644 --- a/test/TOCSpec.hs +++ b/test/TOCSpec.hs @@ -7,6 +7,7 @@ import Category as C import Data.Blob import Data.Functor.Both import Data.Functor.Listable +import Data.Output import Data.Record import Data.Source import Data.Text.Listable @@ -142,17 +143,17 @@ spec = parallel $ do it "produces JSON output" $ do blobs <- blobsForPaths (both "ruby/methods.A.rb" "ruby/methods.B.rb") output <- runTask (diffBlobPair ToCDiffRenderer blobs) - toS output `shouldBe` ("{\"changes\":{\"test/fixtures/toc/ruby/methods.A.rb -> test/fixtures/toc/ruby/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) + toOutput output `shouldBe` ("{\"changes\":{\"test/fixtures/toc/ruby/methods.A.rb -> test/fixtures/toc/ruby/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) it "produces JSON output if there are parse errors" $ do blobs <- blobsForPaths (both "ruby/methods.A.rb" "ruby/methods.X.rb") output <- runTask (diffBlobPair ToCDiffRenderer blobs) - toS output `shouldBe` ("{\"changes\":{\"test/fixtures/toc/ruby/methods.A.rb -> test/fixtures/toc/ruby/methods.X.rb\":[{\"span\":{\"start\":[4,1],\"end\":[5,4]},\"category\":\"Method\",\"term\":\"baz\",\"changeType\":\"removed\"}]},\"errors\":{\"test/fixtures/toc/ruby/methods.A.rb -> test/fixtures/toc/ruby/methods.X.rb\":[{\"span\":{\"start\":[1,1],\"end\":[3,1]},\"error\":\"def bar\\nen\\n\",\"language\":\"Ruby\"}]}}\n" :: ByteString) + toOutput output `shouldBe` ("{\"changes\":{\"test/fixtures/toc/ruby/methods.A.rb -> test/fixtures/toc/ruby/methods.X.rb\":[{\"span\":{\"start\":[4,1],\"end\":[5,4]},\"category\":\"Method\",\"term\":\"baz\",\"changeType\":\"removed\"}]},\"errors\":{\"test/fixtures/toc/ruby/methods.A.rb -> test/fixtures/toc/ruby/methods.X.rb\":[{\"span\":{\"start\":[1,1],\"end\":[3,1]},\"error\":\"def bar\\nen\\n\",\"language\":\"Ruby\"}]}}\n" :: ByteString) it "summarizes Markdown headings" $ do blobs <- blobsForPaths (both "markdown/headings.A.md" "markdown/headings.B.md") output <- runTask (diffBlobPair ToCDiffRenderer blobs) - toS output `shouldBe` ("{\"changes\":{\"test/fixtures/toc/markdown/headings.A.md -> test/fixtures/toc/markdown/headings.B.md\":[{\"span\":{\"start\":[5,1],\"end\":[5,7]},\"category\":\"Heading 2\",\"term\":\"## Two\",\"changeType\":\"added\"},{\"span\":{\"start\":[9,1],\"end\":[10,4]},\"category\":\"Heading 1\",\"term\":\"Final\",\"changeType\":\"added\"}]},\"errors\":{}}\n" :: ByteString) + toOutput output `shouldBe` ("{\"changes\":{\"test/fixtures/toc/markdown/headings.A.md -> test/fixtures/toc/markdown/headings.B.md\":[{\"span\":{\"start\":[5,1],\"end\":[5,7]},\"category\":\"Heading 2\",\"term\":\"## Two\",\"changeType\":\"added\"},{\"span\":{\"start\":[9,1],\"end\":[10,4]},\"category\":\"Heading 1\",\"term\":\"Final\",\"changeType\":\"added\"}]},\"errors\":{}}\n" :: ByteString) type Diff' = SyntaxDiff (Maybe Declaration ': DefaultFields)