Merge branch 'master' into r-o-a-d-m-a-p

semantic-diff.cabal

@@ -30,6 +30,7 @@ library
                      , Data.Mergeable.Generic
                      , Data.Record
                      , Data.Syntax
+                     , Data.Syntax.Algebra
                      , Data.Syntax.Assignment
                      , Data.Syntax.Comment
                      , Data.Syntax.Declaration
@@ -127,6 +128,7 @@ library
                      , network
                      , clock
                      , yaml
+                     , unordered-containers
   default-language:    Haskell2010
   default-extensions:  DeriveFunctor, DeriveFoldable, DeriveTraversable, DeriveGeneric, FlexibleContexts, FlexibleInstances, OverloadedStrings, NoImplicitPrelude, RecordWildCards, StrictData
   ghc-options:        -Wall -fno-warn-name-shadowing -O2 -j

src/Arguments.hs

@@ -14,7 +14,7 @@ import Syntax
 import Term
 import Text.Show
 
-data DiffMode = DiffCommits String String [(FilePath, Maybe Language)] | DiffPaths (FilePath, Maybe Language) (FilePath, Maybe Language)
+data DiffMode = DiffStdin | DiffCommits String String [(FilePath, Maybe Language)] | DiffPaths (FilePath, Maybe Language) (FilePath, Maybe Language)
   deriving Show
 
 data DiffArguments where
@@ -53,7 +53,7 @@ tocDiff :: DiffArguments'
 tocDiff = DiffArguments ToCRenderer declarationDecorator
 
 
-data ParseMode = ParseCommit String [(FilePath, Maybe Language)] | ParsePaths [(FilePath, Maybe Language)]
+data ParseMode = ParseStdin | ParseCommit String [(FilePath, Maybe Language)] | ParsePaths [(FilePath, Maybe Language)]
   deriving Show
 
 data ParseArguments where

src/Command.hs

@@ -3,6 +3,8 @@ module Command
 ( Command
 -- Constructors
 , readFile
+, readBlobPairsFromHandle
+, readBlobsFromHandle
 , readFilesAtSHA
 , readFilesAtSHAs
 -- Evaluation
@@ -32,6 +34,14 @@ type Command = Freer CommandF
 readFile :: FilePath -> Maybe Language -> Command SourceBlob
 readFile path lang = ReadFile path lang `Then` return
 
+-- | Read JSON encoded blob pairs to SourceBlobs.
+readBlobPairsFromHandle :: Handle -> Command [Both SourceBlob]
+readBlobPairsFromHandle h = ReadBlobPairsFromHandle h `Then` return
+
+-- | Read JSON encoded blobs to SourceBlobs.
+readBlobsFromHandle :: Handle -> Command [SourceBlob]
+readBlobsFromHandle h = ReadBlobsFromHandle h `Then` return
+
 -- | Read a list of files at the given commit SHA.
 readFilesAtSHA :: FilePath -- ^ GIT_DIR
                 -> [FilePath] -- ^ GIT_ALTERNATE_OBJECT_DIRECTORIES
@@ -55,6 +65,8 @@ readFilesAtSHAs gitDir alternates paths shas = ReadFilesAtSHAs gitDir alternates
 runCommand :: Command a -> IO a
 runCommand = iterFreerA $ \ command yield -> case command of
   ReadFile path lang -> Files.readFile path lang >>= yield
+  ReadBlobPairsFromHandle h -> Files.readBlobPairsFromHandle h >>= yield
+  ReadBlobsFromHandle h -> Files.readBlobsFromHandle h >>= yield
   ReadFilesAtSHA gitDir alternates paths sha -> Git.readFilesAtSHA gitDir alternates paths sha >>= yield
   ReadFilesAtSHAs gitDir alternates paths shas -> Git.readFilesAtSHAs gitDir alternates paths shas >>= yield
   LiftIO io -> io >>= yield
@@ -64,6 +76,8 @@ runCommand = iterFreerA $ \ command yield -> case command of
 
 data CommandF f where
   ReadFile :: FilePath -> Maybe Language -> CommandF SourceBlob
+  ReadBlobPairsFromHandle :: Handle -> CommandF [Both SourceBlob]
+  ReadBlobsFromHandle :: Handle -> CommandF [SourceBlob]
   ReadFilesAtSHA :: FilePath -> [FilePath] -> [(FilePath, Maybe Language)] -> String -> CommandF [SourceBlob]
   ReadFilesAtSHAs :: FilePath -> [FilePath] -> [(FilePath, Maybe Language)] -> Both String -> CommandF [Both SourceBlob]
   LiftIO :: IO a -> CommandF a
@@ -74,6 +88,8 @@ instance MonadIO Command where
 instance Show1 CommandF where
   liftShowsPrec _ _ d command = case command of
     ReadFile path lang -> showsBinaryWith showsPrec showsPrec "ReadFile" d path lang
+    ReadBlobPairsFromHandle h -> showsUnaryWith showsPrec "ReadBlobPairsFromHandle" d h
+    ReadBlobsFromHandle h -> showsUnaryWith showsPrec "ReadBlobsFromHandle" d h
     ReadFilesAtSHA gitDir alternates paths sha -> showsQuaternaryWith showsPrec showsPrec showsPrec showsPrec "ReadFilesAtSHA" d gitDir alternates paths sha
     ReadFilesAtSHAs gitDir alternates paths shas -> showsQuaternaryWith showsPrec showsPrec showsPrec showsPrec "ReadFilesAtSHAs" d gitDir alternates paths shas
     LiftIO _ -> showsUnaryWith (const showChar) "LiftIO" d '_'

src/Command/Files.hs

@@ -1,17 +1,27 @@
+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, DeriveAnyClass, DuplicateRecordFields #-}
 module Command.Files
 ( readFile
+, readBlobPairsFromHandle
+, readBlobsFromHandle
 , transcode
 , languageForFilePath
 ) where
 
-import Prologue hiding (readFile)
-import Language
-import Source
-import qualified Data.ByteString as B
-import System.FilePath
 import Control.Exception (catch, IOException)
+import Data.Aeson
+import Data.These
+import Data.Functor.Both
+import Data.String
+import Language
+import Prologue hiding (readFile)
+import qualified Data.ByteString as B
+import qualified Data.HashMap.Strict as HM
 import qualified Data.Text.ICU.Convert as Convert
 import qualified Data.Text.ICU.Detect as Detect
+import Prelude (fail)
+import Source hiding (path)
+import System.FilePath
+
 
 -- | Read a file to a SourceBlob, transcoding to UTF-8 along the way.
 readFile :: FilePath -> Maybe Language -> IO SourceBlob
@@ -30,3 +40,52 @@ transcode text = fromText <$> do
 -- | Return a language based on a FilePath's extension, or Nothing if extension is not found or not supported.
 languageForFilePath :: FilePath -> Maybe Language
 languageForFilePath = languageForType . toS . takeExtension
+
+-- | Read JSON encoded blob pairs from a handle.
+readBlobPairsFromHandle :: Handle -> IO [Both SourceBlob]
+readBlobPairsFromHandle = fmap toSourceBlobPairs . readFromHandle
+  where
+    toSourceBlobPairs BlobDiff{..} = toSourceBlobPair <$> blobs
+    toSourceBlobPair blobs = Join (fromThese empty empty (runJoin (toSourceBlob <$> blobs)))
+      where empty = emptySourceBlob (mergeThese const (runJoin (path <$> blobs)))
+
+-- | Read JSON encoded blobs from a handle.
+readBlobsFromHandle :: Handle -> IO [SourceBlob]
+readBlobsFromHandle = fmap toSourceBlobs . readFromHandle
+  where toSourceBlobs BlobParse{..} = fmap toSourceBlob blobs
+
+readFromHandle :: FromJSON a => Handle -> IO a
+readFromHandle h = do
+  input <- B.hGetContents h
+  case decode (toS input) of
+    Just d -> pure d
+    Nothing -> die ("invalid input on " <> show h <> ", expecting JSON")
+
+toSourceBlob :: Blob -> SourceBlob
+toSourceBlob Blob{..} = sourceBlob path language' (Source (encodeUtf8 content))
+  where language' = case language of
+          "" -> languageForFilePath path
+          _ -> readMaybe language
+
+
+newtype BlobDiff = BlobDiff { blobs :: [BlobPair] }
+  deriving (Show, Generic, FromJSON)
+
+newtype BlobParse = BlobParse { blobs :: [Blob] }
+  deriving (Show, Generic, FromJSON)
+
+type BlobPair = Join These Blob
+
+data Blob = Blob
+  { path :: String
+  , content :: Text
+  , language :: String
+  } deriving (Show, Generic, FromJSON)
+
+instance FromJSON BlobPair where
+  parseJSON = withObject "BlobPair" $ \o ->
+    case (HM.lookup "before" o, HM.lookup "after" o) of
+      (Just before, Just after) -> Join <$> (These <$> parseJSON before <*> parseJSON after)
+      (Just before, Nothing) -> Join . This <$> parseJSON before
+      (Nothing, Just after) -> Join . That <$> parseJSON after
+      _ -> fail "Expected object with 'before' and/or 'after' keys only"

src/Data/Syntax/Algebra.hs

@@ -0,0 +1,57 @@
+{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TypeOperators #-}
+module Data.Syntax.Algebra where
+
+import Data.Functor.Foldable
+import Data.Functor.Union
+import Data.Record
+import qualified Data.Syntax as Syntax
+import qualified Data.Syntax.Declaration as Declaration
+import qualified Data.Syntax.Statement as Statement
+import Prologue
+import Term
+
+-- | An F-algebra on some carrier functor 'f'.
+type FAlgebra f a = f a -> a
+
+-- | An R-algebra on some carrier functor 'f' of its fixpoint type 't'.
+type RAlgebra f t a = f (t, a) -> a
+
+-- | Promote an FAlgebra into an RAlgebra (by dropping the original parameter).
+fToR :: Functor (Base t) => FAlgebra (Base t) a -> RAlgebra (Base t) t a
+fToR f = f . fmap snd
+
+newtype Identifier = Identifier ByteString
+  deriving (Eq, Show)
+
+-- | Produce the identifier for a given term, if any.
+--
+--   Identifier syntax is labelled, as well as declaration syntax identified by these, but other uses of these identifiers are not, e.g. the declaration of a class or method or binding of a variable will be labelled, but a function call will not.
+identifierAlg :: (InUnion fs Syntax.Identifier, InUnion fs Declaration.Method, InUnion fs Declaration.Class, Traversable (Union fs)) => FAlgebra (Base (Term (Union fs) a)) (Maybe Identifier)
+identifierAlg (_ :< union) = case union of
+  _ | Just (Syntax.Identifier s) <- prj union -> Just (Identifier s)
+  _ | Just Declaration.Class{..} <- prj union -> classIdentifier
+  _ | Just Declaration.Method{..} <- prj union -> methodName
+  _ -> Nothing
+
+-- | The cyclomatic complexity of a (sub)term.
+newtype CyclomaticComplexity = CyclomaticComplexity Int
+  deriving (Enum, Eq, Num, Ord, Show)
+
+-- | Compute the cyclomatic complexity of a (sub)term, measured as the number places where control exits scope, e.g. returns and yields.
+--
+--   TODO: Explicit returns at the end of methods should only count once.
+--   TODO: Anonymous functions should not increase parent scope’s complexity.
+--   TODO: Inner functions should not increase parent scope’s complexity.
+cyclomaticComplexityAlg :: (InUnion fs Declaration.Method, InUnion fs Statement.Return, InUnion fs Statement.Yield, Traversable (Union fs)) => FAlgebra (Base (Term (Union fs) a)) CyclomaticComplexity
+cyclomaticComplexityAlg (_ :< union) = case union of
+  _ | Just Declaration.Method{} <- prj union -> succ (sum union)
+  _ | Just Statement.Return{} <- prj union -> succ (sum union)
+  _ | Just Statement.Yield{} <- prj union -> succ (sum union)
+  _ -> sum union
+
+-- | Lift an algebra into a decorator for terms annotated with records.
+decoratorWithAlgebra :: Functor f
+                     => RAlgebra (Base (Term f (Record fs))) (Term f (Record fs)) a -- ^ An F-algebra on terms.
+                     -> Term f (Record fs) -- ^ A term to decorate with values produced by the F-algebra.
+                     -> Term f (Record (a ': fs)) -- ^ A term decorated with values produced by the F-algebra.
+decoratorWithAlgebra alg = para $ \ c@(a :< f) -> cofree $ (alg (fmap (second (rhead . extract)) c) :. a) :< fmap snd f

src/Language/Ruby/Syntax.hs

@@ -1,19 +1,11 @@
-{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TypeOperators #-}
+{-# LANGUAGE DataKinds #-}
 module Language.Ruby.Syntax
 ( assignment
 , Syntax
 , Grammar
-, FAlgebra
-, RAlgebra
-, fToR
-, identifierAlg
-, cyclomaticComplexityAlg
-, decoratorWithAlgebra
 ) where
 
-import Data.Functor.Foldable (Base)
 import Data.Functor.Union
-import Data.Record
 import qualified Data.Syntax as Syntax
 import Data.Syntax.Assignment
 import qualified Data.Syntax.Comment as Comment
@@ -158,50 +150,3 @@ makeTerm a f = cofree $ a :< inj f
 
 emptyTerm :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
 emptyTerm = makeTerm <$> location <*> pure Syntax.Empty
-
-
--- | An F-algebra on some carrier functor 'f'.
-type FAlgebra f a = f a -> a
-
--- | An R-algebra on some carrier functor 'f' of its fixpoint type 't'.
-type RAlgebra f t a = f (t, a) -> a
-
--- | Promote an FAlgebra into an RAlgebra (by dropping the original parameter).
-fToR :: Functor (Base t) => FAlgebra (Base t) a -> RAlgebra (Base t) t a
-fToR f = f . fmap snd
-
-newtype Identifier' = Identifier' ByteString
-  deriving (Eq, Show)
-
--- | Produce the identifier for a given term, if any.
---
---   Identifier syntax is labelled, as well as declaration syntax identified by these, but other uses of these identifiers are not, e.g. the declaration of a class or method or binding of a variable will be labelled, but a function call will not.
-identifierAlg :: (InUnion fs Syntax.Identifier, InUnion fs Declaration.Method, InUnion fs Declaration.Class, Traversable (Union fs)) => FAlgebra (Base (Term (Union fs) a)) (Maybe Identifier')
-identifierAlg (_ :< union) = case union of
-  _ | Just (Syntax.Identifier s) <- prj union -> Just (Identifier' s)
-  _ | Just Declaration.Class{..} <- prj union -> classIdentifier
-  _ | Just Declaration.Method{..} <- prj union -> methodName
-  _ -> Nothing
-
--- | The cyclomatic complexity of a (sub)term.
-newtype CyclomaticComplexity = CyclomaticComplexity Int
-  deriving (Enum, Eq, Num, Ord, Show)
-
--- | Compute the cyclomatic complexity of a (sub)term, measured as the number places where control exits scope, e.g. returns and yields.
---
---   TODO: Explicit returns at the end of methods should only count once.
---   TODO: Anonymous functions should not increase parent scope’s complexity.
---   TODO: Inner functions should not increase parent scope’s complexity.
-cyclomaticComplexityAlg :: (InUnion fs Declaration.Method, InUnion fs Statement.Return, InUnion fs Statement.Yield, Traversable (Union fs)) => FAlgebra (Base (Term (Union fs) a)) CyclomaticComplexity
-cyclomaticComplexityAlg (_ :< union) = case union of
-  _ | Just Declaration.Method{} <- prj union -> succ (sum union)
-  _ | Just Statement.Return{} <- prj union -> succ (sum union)
-  _ | Just Statement.Yield{} <- prj union -> succ (sum union)
-  _ -> sum union
-
--- | Lift an algebra into a decorator for terms annotated with records.
-decoratorWithAlgebra :: Functor f
-                     => RAlgebra (Base (Term f (Record fs))) (Term f (Record fs)) a -- ^ An F-algebra on terms.
-                     -> Term f (Record fs) -- ^ A term to decorate with values produced by the F-algebra.
-                     -> Term f (Record (a ': fs)) -- ^ A term decorated with values produced by the F-algebra.
-decoratorWithAlgebra alg = para $ \ c@(a :< f) -> cofree $ (alg (fmap (second (rhead . extract)) c) :. a) :< fmap snd f

src/Renderer.hs

@@ -18,9 +18,9 @@ import Data.Functor.Classes
 import Text.Show
 import Data.Map as Map hiding (null)
 import Data.Record
+import Data.Syntax.Algebra (RAlgebra, decoratorWithAlgebra)
 import Diff
 import Info hiding (Identifier)
-import Language.Ruby.Syntax (RAlgebra, decoratorWithAlgebra)
 import Prologue
 import Renderer.JSON as R
 import Renderer.Patch as R

src/Renderer/JSON.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, MultiParamTypeClasses, DataKinds, GADTs, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE DataKinds, GADTs, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Renderer.JSON
 ( json
@@ -6,20 +6,17 @@ module Renderer.JSON
 , ToJSONFields(..)
 ) where
 
-import Alignment
 import Data.Aeson (ToJSON, toJSON, encode, object, (.=))
 import Data.Aeson as A hiding (json)
 import Data.Bifunctor.Join
 import Data.Functor.Both
 import Data.Record
-import Data.These
-import Data.Vector as Vector hiding (toList)
 import Diff
 import Info
+import Patch
 import Prologue hiding ((++))
 import qualified Data.Map as Map
 import Source
-import SplitDiff
 import Syntax as S
 
 --
@@ -28,29 +25,21 @@ import Syntax as S
 
 -- | Render a diff to a string representing its JSON.
 json :: (ToJSONFields (Record fields), HasField fields Range) => Both SourceBlob -> Diff (Syntax Text) (Record fields) -> Map Text Value
-json blobs diff = Map.fromList [
-  ("rows", toJSON (annotateRows (alignDiff (source <$> blobs) diff))),
-  ("oids", toJSON (oid <$> blobs)),
-  ("paths", toJSON (path <$> blobs)) ]
-  where annotateRows :: [Join These a] -> [Join These (NumberedLine a)]
-        annotateRows = fmap (fmap NumberedLine) . numberedRows
-
--- | A numbered 'a'.
-newtype NumberedLine a = NumberedLine (Int, a)
+json blobs diff = Map.fromList
+  [ ("diff", toJSON diff)
+  , ("oids", toJSON (oid <$> blobs))
+  , ("paths", toJSON (path <$> blobs))
+  ]
 
 instance StringConv (Map Text Value) ByteString where
   strConv _ = toS . (<> "\n") . encode
 
-instance ToJSONFields a => ToJSON (NumberedLine a) where
-  toJSON (NumberedLine (n, a)) = object $ "number" .= n : toJSONFields a
-  toEncoding (NumberedLine (n, a)) = pairs $ "number" .= n <> mconcat (toJSONFields a)
-
-instance ToJSON a => ToJSON (Join These a) where
-  toJSON (Join vs) = A.Array . Vector.fromList $ toJSON <$> these pure pure (\ a b -> [ a, b ]) vs
-  toEncoding = foldable
+instance ToJSON a => ToJSONFields (Join (,) a) where
+  toJSONFields (Join (a, b)) = [ "before" .= a, "after" .= b ]
 
 instance ToJSON a => ToJSON (Join (,) a) where
-  toJSON (Join (a, b)) = A.Array . Vector.fromList $ toJSON <$> [ a, b ]
+  toJSON = toJSON . toList
+  toEncoding = foldable
 
 instance (ToJSONFields a, ToJSONFields (f (Free f a))) => ToJSON (Free f a) where
   toJSON splitDiff = case runFree splitDiff of
@@ -73,6 +62,10 @@ instance (ToJSONFields h, ToJSONFields (Record t)) => ToJSONFields (Record (h ':
 instance ToJSONFields (Record '[]) where
   toJSONFields _ = []
 
+instance ToJSONFields (Record fs) => ToJSON (Record fs) where
+  toJSON = object . toJSONFields
+  toEncoding = pairs . mconcat . toJSONFields
+
 instance ToJSONFields Range where
   toJSONFields Range{..} = ["sourceRange" .= [ start, end ]]
 
@@ -101,10 +94,10 @@ instance (ToJSONFields a, ToJSONFields (f b)) => ToJSONFields (FreeF f a b) wher
   toJSONFields (Free f) = toJSONFields f
   toJSONFields (Pure a) = toJSONFields a
 
-instance ToJSON a => ToJSONFields (SplitPatch a) where
-  toJSONFields (SplitInsert a) = [ "insert" .= a ]
-  toJSONFields (SplitDelete a) = [ "delete" .= a ]
-  toJSONFields (SplitReplace a) = [ "replace" .= a ]
+instance ToJSON a => ToJSONFields (Patch a) where
+  toJSONFields (Insert a) = [ "insert" .= a ]
+  toJSONFields (Delete a) = [ "delete" .= a ]
+  toJSONFields (Replace a b) = [ "replace" .= [a, b] ]
 
 instance ToJSON a => ToJSONFields [a] where
   toJSONFields list = [ "children" .= list ]

src/SemanticCmdLine.hs

@@ -17,6 +17,7 @@ import System.Directory
 import System.Environment
 import System.FilePath.Posix (takeFileName, (-<.>))
 import System.IO.Error (IOError)
+import System.IO (stdin)
 import Text.Regex
 import qualified Semantic (parseBlobs, diffBlobPairs)
 
@@ -48,8 +49,9 @@ main = do
 runDiff :: DiffArguments -> IO ByteString
 runDiff DiffArguments{..} = do
   blobs <- runCommand $ case diffMode of
-   DiffPaths a b -> pure <$> traverse (uncurry readFile) (both a b)
-   DiffCommits sha1 sha2 paths -> readFilesAtSHAs gitDir alternateObjectDirs paths (both sha1 sha2)
+    DiffPaths a b -> pure <$> traverse (uncurry readFile) (both a b)
+    DiffCommits sha1 sha2 paths -> readFilesAtSHAs gitDir alternateObjectDirs paths (both sha1 sha2)
+    DiffStdin -> readBlobPairsFromHandle stdin
   Semantic.diffBlobPairs termDecorator diffRenderer blobs
 
 runParse :: ParseArguments -> IO ByteString
@@ -57,6 +59,7 @@ runParse ParseArguments{..} = do
   blobs <- runCommand $ case parseMode of
     ParsePaths paths -> traverse (uncurry readFile) paths
     ParseCommit sha paths -> readFilesAtSHA gitDir alternateObjectDirs paths sha
+    ParseStdin -> readBlobsFromHandle stdin
   Semantic.parseBlobs parseTreeRenderer blobs
 
 -- | A parser for the application's command-line arguments.
@@ -84,7 +87,8 @@ arguments gitDir alternates = info (version <*> helper <*> argumentsParser) desc
             <|> 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 filePathReader (metavar "FILES...")) )
+               <*> many (argument filePathReader (metavar "FILES..."))
+            <|> pure DiffStdin )
          <*> pure gitDir
          <*> pure alternates )
 
@@ -96,7 +100,8 @@ arguments gitDir alternates = info (version <*> helper <*> argumentsParser) desc
                <$> some (argument filePathReader (metavar "FILES..."))
             <|> ParseCommit
                <$> option (eitherReader parseSha) (long "sha" <> metavar "SHA" <> help "Commit SHA")
-               <*> some (argument filePathReader (metavar "FILES...")) )
+               <*> some (argument filePathReader (metavar "FILES..."))
+            <|> pure ParseStdin )
          <*> pure gitDir
          <*> pure alternates )
 

test/CommandSpec.hs

@@ -31,6 +31,47 @@ spec = parallel $ do
       blob <- runCommand (readFile "this file should not exist" Nothing)
       nullBlob blob `shouldBe` True
 
+  describe "readBlobPairsFromHandle" $ do
+    it "returns blobs for valid JSON encoded diff input" $ do
+      h <- openFile "test/fixtures/input/diff.json" ReadMode
+      blobs <- runCommand (readBlobPairsFromHandle h)
+      let a = sourceBlob "method.rb" (Just Ruby) "def foo; end"
+      let b = sourceBlob "method.rb" (Just Ruby) "def bar(x); end"
+      blobs `shouldBe` [both a b]
+
+    it "returns blobs for unsupported language" $ do
+      h <- openFile "test/fixtures/input/diff-unsupported-language.json" ReadMode
+      blobs <- runCommand (readBlobPairsFromHandle h)
+      let a = emptySourceBlob "test.kt"
+      let b = sourceBlob "test.kt" Nothing "fun main(args: Array<String>) {\nprintln(\"hi\")\n}\n"
+      blobs `shouldBe` [both a b]
+
+    it "detects language based on filepath for empty language" $ do
+      h <- openFile "test/fixtures/input/diff-empty-language.json" ReadMode
+      blobs <- runCommand (readBlobPairsFromHandle h)
+      let a = sourceBlob "method.rb" (Just Ruby) "def foo; end"
+      let b = sourceBlob "method.rb" (Just Ruby) "def bar(x); end"
+      blobs `shouldBe` [both a b]
+
+    it "throws on blank input" $ do
+      h <- openFile "test/fixtures/input/blank.json" ReadMode
+      runCommand (readBlobPairsFromHandle h) `shouldThrow` (== ExitFailure 1)
+
+    it "throws if language field not given" $ do
+      h <- openFile "test/fixtures/input/diff-no-language.json" ReadMode
+      runCommand (readBlobsFromHandle h) `shouldThrow` (== ExitFailure 1)
+
+  describe "readBlobsFromHandle" $ do
+    it "returns blobs for valid JSON encoded parse input" $ do
+      h <- openFile "test/fixtures/input/parse.json" ReadMode
+      blobs <- runCommand (readBlobsFromHandle h)
+      let a = sourceBlob "method.rb" (Just Ruby) "def foo; end"
+      blobs `shouldBe` [a]
+
+    it "throws on blank input" $ do
+      h <- openFile "test/fixtures/input/blank.json" ReadMode
+      runCommand (readBlobsFromHandle h) `shouldThrow` (== ExitFailure 1)
+
   describe "readFilesAtSHA" $ do
     it "returns blobs for the specified paths" $ do
       blobs <- runCommand (readFilesAtSHA repoPath [] [("methods.rb", Just Ruby)] (Both.snd (shas methodsFixture)))

test/SemanticCmdLineSpec.hs

@@ -76,8 +76,8 @@ instance Listable DiffFixture where
       patchOutput = "diff --git a/test/fixtures/ruby/method-declaration.A.rb b/test/fixtures/ruby/method-declaration.B.rb\nindex 0000000000000000000000000000000000000000..0000000000000000000000000000000000000000 100644\n--- a/test/fixtures/ruby/method-declaration.A.rb\n+++ b/test/fixtures/ruby/method-declaration.B.rb\n@@ -1,3 +1,4 @@\n-def foo\n+def bar(a)\n+  baz\n end\n\n"
       patchOutput' = "diff --git a/methods.rb b/methods.rb\nnew file mode 100644\nindex 0000000000000000000000000000000000000000..ff7bbbe9495f61d9e1e58c597502d152bab1761e\n--- /dev/null\n+++ b/methods.rb\n+def foo\n+end\n\n"
 
-      jsonOutput = "{\"oids\":[\"0000000000000000000000000000000000000000\",\"0000000000000000000000000000000000000000\"],\"paths\":[\"test/fixtures/ruby/method-declaration.A.rb\",\"test/fixtures/ruby/method-declaration.B.rb\"],\"rows\":[[{\"category\":\"Program\",\"children\":[{\"category\":\"Method\",\"children\":[{\"replace\":{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}}}],\"sourceRange\":[0,8],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}}],\"sourceRange\":[0,8],\"number\":1,\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},{\"category\":\"Program\",\"children\":[{\"category\":\"Method\",\"children\":[{\"replace\":{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}}},{\"insert\":{\"category\":\"Params\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[8,9],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,10]}}],\"sourceRange\":[7,11],\"sourceSpan\":{\"start\":[1,8],\"end\":[2,3]}}}],\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,4]}}],\"sourceRange\":[0,11],\"number\":1,\"sourceSpan\":{\"start\":[1,1],\"end\":[4,1]}}],[{\"category\":\"Program\",\"children\":[{\"category\":\"Method\",\"children\":[{\"insert\":{\"category\":\"Params\",\"children\":[],\"sourceRange\":[11,13],\"sourceSpan\":{\"start\":[1,8],\"end\":[2,3]}}},{\"insert\":{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}}}],\"sourceRange\":[11,17],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,4]}}],\"sourceRange\":[11,17],\"number\":2,\"sourceSpan\":{\"start\":[1,1],\"end\":[4,1]}}],[{\"category\":\"Program\",\"children\":[{\"category\":\"Method\",\"children\":[],\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}}],\"sourceRange\":[8,12],\"number\":2,\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},{\"category\":\"Program\",\"children\":[{\"category\":\"Method\",\"children\":[],\"sourceRange\":[17,20],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,4]}}],\"sourceRange\":[17,21],\"number\":3,\"sourceSpan\":{\"start\":[1,1],\"end\":[4,1]}}],[{\"category\":\"Program\",\"children\":[],\"sourceRange\":[12,12],\"number\":3,\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},{\"category\":\"Program\",\"children\":[],\"sourceRange\":[21,21],\"number\":4,\"sourceSpan\":{\"start\":[1,1],\"end\":[4,1]}}]]}\n"
-      jsonOutput' = "{\"oids\":[\"0000000000000000000000000000000000000000\",\"ff7bbbe9495f61d9e1e58c597502d152bab1761e\"],\"paths\":[\"methods.rb\",\"methods.rb\"],\"rows\":[[{\"insert\":{\"category\":\"Program\",\"children\":[{\"category\":\"Method\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}}],\"sourceRange\":[0,8],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}}],\"sourceRange\":[0,8],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},\"number\":1}],[{\"insert\":{\"category\":\"Program\",\"children\":[{\"category\":\"Method\",\"children\":[],\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}}],\"sourceRange\":[8,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},\"number\":2}],[{\"insert\":{\"category\":\"Program\",\"children\":[],\"sourceRange\":[12,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},\"number\":3}]]}\n"
+      jsonOutput = "{\"diff\":{\"after\":{\"category\":\"Program\",\"sourceRange\":[0,21],\"sourceSpan\":{\"start\":[1,1],\"end\":[4,1]}},\"children\":[{\"after\":{\"category\":\"Method\",\"sourceRange\":[0,20],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,4]}},\"children\":[{\"replace\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}},{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}}]},{\"insert\":{\"category\":\"Params\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[8,9],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,10]}}],\"sourceRange\":[7,13],\"sourceSpan\":{\"start\":[1,8],\"end\":[2,3]}}},{\"insert\":{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}}}],\"before\":{\"category\":\"Method\",\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}}}],\"before\":{\"category\":\"Program\",\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}}},\"oids\":[\"0000000000000000000000000000000000000000\",\"0000000000000000000000000000000000000000\"],\"paths\":[\"test/fixtures/ruby/method-declaration.A.rb\",\"test/fixtures/ruby/method-declaration.B.rb\"]}\n"
+      jsonOutput' = "{\"diff\":{\"insert\":{\"category\":\"Program\",\"children\":[{\"category\":\"Method\",\"children\":[{\"category\":\"Identifier\",\"children\":[],\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}}],\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}}],\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}}},\"oids\":[\"0000000000000000000000000000000000000000\",\"ff7bbbe9495f61d9e1e58c597502d152bab1761e\"],\"paths\":[\"methods.rb\",\"methods.rb\"]}\n"
       sExpressionOutput = "(Program\n  (Method\n  { (Identifier)\n  ->(Identifier) }\n  {+(Params\n      (Identifier))+}\n  {+(Identifier)+}))\n"
       sExpressionOutput' = "{+(Program\n  (Method\n    (Identifier)))+}\n"
       tocOutput = "{\"changes\":{\"test/fixtures/ruby/method-declaration.A.rb -> test/fixtures/ruby/method-declaration.B.rb\":[{\"span\":{\"start\":[1,1],\"end\":[3,4]},\"category\":\"Method\",\"term\":\"bar\",\"changeType\":\"modified\"}]},\"errors\":{}}\n"

test/fixtures/input/diff-empty-language.json

@@ -0,0 +1,14 @@
+{
+  "blobs": [{
+    "before": {
+      "path": "method.rb",
+      "content": "def foo; end",
+      "language": ""
+    },
+    "after": {
+      "path": "method.rb",
+      "content": "def bar(x); end",
+      "language": ""
+    }
+  }]
+}

test/fixtures/input/diff-no-language.json

@@ -0,0 +1,12 @@
+{
+  "blobs": [{
+    "before": {
+      "path": "method.rb",
+      "content": "def foo; end",
+    },
+    "after": {
+      "path": "method.rb",
+      "content": "def bar(x); end",
+    }
+  }]
+}

test/fixtures/input/diff-unsupported-language.json

@@ -0,0 +1,9 @@
+{
+  "blobs": [{
+    "after": {
+      "path": "test.kt",
+      "content": "fun main(args: Array<String>) {\nprintln(\"hi\")\n}\n",
+      "language": "Kotlin"
+    }
+  }]
+}

test/fixtures/input/diff.json

@@ -0,0 +1,14 @@
+{
+  "blobs": [{
+    "before": {
+      "path": "method.rb",
+      "content": "def foo; end",
+      "language": "Ruby"
+    },
+    "after": {
+      "path": "method.rb",
+      "content": "def bar(x); end",
+      "language": "Ruby"
+    }
+  }]
+}

test/fixtures/input/parse.json

@@ -0,0 +1,7 @@
+{
+  "blobs": [{
+    "path": "method.rb",
+    "content": "def foo; end",
+    "language": "Ruby"
+  }]
+}