Merge pull request #1264 from github/output-typeclass

Output typeclass

semantic-diff.cabal

@@ -24,6 +24,7 @@ library
                      , Data.Functor.Listable
                      , Data.Mergeable
                      , Data.Mergeable.Generic
+                     , Data.Output
                      , Data.Range
                      , Data.Record
                      , Data.Source

src/Data/Output.hs

@@ -0,0 +1,9 @@
+module Data.Output where
+
+import Prologue
+
+class Monoid o => Output o where
+  toOutput :: o -> ByteString
+
+instance Output ByteString where
+  toOutput s = s

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)
 

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

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.

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 ]

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

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)