Merge remote-tracking branch 'origin/master' into more-ruby-parsing

semantic-diff.cabal

@@ -54,6 +54,7 @@ library
                      , Syntax
                      , Term
                      , Term.Arbitrary
+                     , Term.Instances
                      , TreeSitter
   build-depends:       base >= 4.8 && < 5
                      , aeson

src/Data/Record.hs

@@ -7,6 +7,8 @@ import Test.QuickCheck
 import Category
 import Range
 import SourceSpan
+import Data.Aeson
+import Data.Aeson.Types
 
 
 -- | A type alias for HasField constraints commonly used throughout semantic-diff.
@@ -61,6 +63,12 @@ instance (Show h, Show (Record t)) => Show (Record (h ': t)) where
 instance Show (Record '[]) where
   showsPrec n RNil = showParen (n > 0) ("RNil" <>)
 
+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON (Record (a ': b ': c ': d ': '[])) where
+  toJSON (RCons a (RCons b (RCons c (RCons d RNil)))) = toJSONList [toJSON a, toJSON b, toJSON c, toJSON d]
+
+instance ToJSON (Record '[]) where
+  toJSON _ = emptyArray
+
 
 instance (Eq h, Eq (Record t)) => Eq (Record (h ': t)) where
   RCons h1 t1 == RCons h2 t2 = h1 == h2 && t1 == t2

src/Diffing.hs

@@ -32,7 +32,7 @@ import Term
 import TreeSitter
 import Text.Parser.TreeSitter.Language
 import qualified Data.Text as T
-import Data.Aeson (toJSON, toEncoding)
+import Data.Aeson (ToJSON, toJSON, toEncoding)
 import Data.Aeson.Encoding (encodingToLazyByteString)
 
 -- | Given a parser and renderer, diff two sources and return the rendered
@@ -127,7 +127,7 @@ diffCostWithCachedTermCosts diff = unCost $ case runFree diff of
   Pure patch -> sum (cost . extract <$> patch)
 
 -- | Returns a rendered diff given a parser, diff arguments and two source blobs.
-textDiff :: (DefaultFields fields, HasField fields Cost) => Parser (Syntax Text) (Record fields) -> DiffArguments -> Both SourceBlob -> IO Output
+textDiff :: (ToJSON (Record fields), DefaultFields fields, HasField fields Cost) => Parser (Syntax Text) (Record fields) -> DiffArguments -> Both SourceBlob -> IO Output
 textDiff parser arguments = diffFiles parser $ case format arguments of
   Split -> split
   Patch -> patch
@@ -143,7 +143,7 @@ truncatedDiff arguments sources = pure $ case format arguments of
   Summary -> SummaryOutput mempty
 
 -- | Prints a rendered diff to stdio or a filepath given a parser, diff arguments and two source blobs.
-printDiff :: (DefaultFields fields, HasField fields Cost) => Parser (Syntax Text) (Record fields) -> DiffArguments -> Both SourceBlob -> IO ()
+printDiff :: (ToJSON (Record fields), DefaultFields fields, HasField fields Cost) => Parser (Syntax Text) (Record fields) -> DiffArguments -> Both SourceBlob -> IO ()
 printDiff parser arguments sources = do
   rendered <- textDiff parser arguments sources
   let renderedText = case rendered of

src/Info.hs

@@ -7,9 +7,10 @@ import Category
 import Range
 import SourceSpan
 import Test.QuickCheck
+import Data.Aeson
 
 newtype Cost = Cost { unCost :: Int }
-  deriving (Eq, Num, Ord, Show)
+  deriving (Eq, Num, Ord, Show, ToJSON)
 
 characterRange :: HasField fields Range => Record fields -> Range
 characterRange = getField

src/Renderer/JSON.hs

@@ -22,7 +22,7 @@ import Term
 import qualified Data.Map as Map
 
 -- | Render a diff to a string representing its JSON.
-json :: (HasField fields Category, HasField fields Range) => Renderer (Record fields)
+json :: (ToJSON (Record fields), HasField fields Category, HasField fields Range) => Renderer (Record fields)
 json blobs diff = JSONOutput $ Map.fromList [
   ("rows", toJSON (annotateRows (alignDiff (source <$> blobs) diff))),
   ("oids", toJSON (oid <$> blobs)),
@@ -32,7 +32,7 @@ json blobs diff = JSONOutput $ Map.fromList [
 -- | A numbered 'a'.
 newtype NumberedLine a = NumberedLine (Int, a)
 
-instance (HasField fields Category, HasField fields Range) => ToJSON (NumberedLine (SplitSyntaxDiff leaf fields)) where
+instance (ToJSON leaf, ToJSON (Record fields), HasField fields Category, HasField fields Range) => ToJSON (NumberedLine (SplitSyntaxDiff leaf fields)) where
   toJSON (NumberedLine (n, a)) = object (lineFields n a (getRange a))
   toEncoding (NumberedLine (n, a)) = pairs $ mconcat (lineFields n a (getRange a))
 
@@ -51,7 +51,7 @@ instance ToJSON a => ToJSON (Join These a) where
 instance ToJSON a => ToJSON (Join (,) a) where
   toJSON (Join (a, b)) = A.Array . Vector.fromList $ toJSON <$> [ a, b ]
 
-instance (HasField fields Category, HasField fields Range) => ToJSON (SplitSyntaxDiff leaf fields) where
+instance (ToJSON leaf, ToJSON (Record fields), HasField fields Category, HasField fields Range) => ToJSON (SplitSyntaxDiff leaf fields) where
   toJSON splitDiff = case runFree splitDiff of
     (Free (info :< syntax)) -> object (termFields info syntax)
     (Pure patch)            -> object (patchFields patch)
@@ -59,11 +59,13 @@ instance (HasField fields Category, HasField fields Range) => ToJSON (SplitSynta
     (Free (info :< syntax)) -> pairs $ mconcat (termFields info syntax)
     (Pure patch)            -> pairs $ mconcat (patchFields patch)
 
-instance (HasField fields Category, HasField fields Range) => ToJSON (SyntaxTerm leaf fields) where
-  toJSON term     | (info :< syntax) <- runCofree term = object (termFields info syntax)
-  toEncoding term | (info :< syntax) <- runCofree term = pairs $ mconcat (termFields info syntax)
+instance (ToJSON (Record fields), ToJSON leaf, HasField fields Category, HasField fields Range) => ToJSON (SyntaxTerm leaf fields) where
+  toJSON term     |
+    (info :< syntax) <- runCofree term = object (termFields info syntax)
+  toEncoding term |
+    (info :< syntax) <- runCofree term = pairs $ mconcat (termFields info syntax)
 
-lineFields :: (HasField fields Category, HasField fields Range) => KeyValue kv => Int -> SplitSyntaxDiff leaf fields -> Range -> [kv]
+lineFields :: (ToJSON leaf, ToJSON (Record fields), HasField fields Category, HasField fields Range) => KeyValue kv => Int -> SplitSyntaxDiff leaf fields -> Range -> [kv]
 lineFields n term range = [ "number" .= n
                           , "terms" .= [ term ]
                           , "range" .= range
@@ -76,12 +78,14 @@ termFields :: (ToJSON recur, KeyValue kv, HasField fields Category, HasField fie
   [kv]
 termFields info syntax = "range" .= characterRange info : "category" .= category info : syntaxToTermField syntax
 
-patchFields :: (KeyValue kv, HasField fields Category, HasField fields Range) => SplitPatch (SyntaxTerm leaf fields) -> [kv]
+patchFields :: (ToJSON (Record fields), ToJSON leaf, KeyValue kv, HasField fields Category, HasField fields Range) => SplitPatch (SyntaxTerm leaf fields) -> [kv]
 patchFields patch = case patch of
   SplitInsert term -> fields "insert" term
   SplitDelete term -> fields "delete" term
   SplitReplace term -> fields "replace" term
-  where fields kind term | (info :< syntax) <- runCofree term = "patch" .= T.pack kind : termFields info syntax
+  where
+    fields kind term |
+      (info :< syntax) <- runCofree term = "patch" .= T.pack kind : termFields info syntax
 
 syntaxToTermField :: (ToJSON recur, KeyValue kv) => Syntax leaf recur -> [kv]
 syntaxToTermField syntax = case syntax of

src/Syntax.hs

@@ -5,6 +5,7 @@ import Prologue
 import Data.Mergeable
 import GHC.Generics
 import Test.QuickCheck hiding (Fixed)
+import Data.Aeson
 
 -- | A node in an abstract syntax tree.
 --
@@ -87,10 +88,11 @@ data Syntax a f
   | BlockExpression (Maybe f) [f]
   -- | A rescue block: maybe Args to rescue, maybe a local var for the last exception, and a list of expressions.
   | Rescue (Maybe f) (Maybe f) [f]
-  -- | A rescue modifier has a left and right expression (e.g. foo rescue nil).
+  -- | A rescue modifier has a left and right expression (e.g. in Ruby foo rescue nil).
   | RescueModifier f f
+  -- | The last exception captured in a rescue block to a local variable (e.g. in Ruby rescue => x).
   | LastException f
-  deriving (Eq, Foldable, Functor, Generic, Generic1, Mergeable, Ord, Show, Traversable)
+  deriving (Eq, Foldable, Functor, Generic, Generic1, Mergeable, Ord, Show, Traversable, ToJSON)
 
 
 -- Instances

src/Term/Instances.hs

@@ -0,0 +1,11 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Term.Instances where
+
+import Prologue
+import Data.Record
+import Term
+import Data.Aeson
+
+instance (ToJSON leaf, ToJSON (Record fields)) => ToJSON (SyntaxTerm leaf fields) where
+  toJSON syntaxTerm = case runCofree syntaxTerm of
+    (record :< syntax) -> object [ ("record", toJSON record), ("syntax", toJSON syntax) ]