Merge branch 'master' into diff-parse-stdin

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

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 ]

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"