diff --git a/semantic-diff.cabal b/semantic-diff.cabal index 056df46a3..a05738a23 100644 --- a/semantic-diff.cabal +++ b/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 diff --git a/src/Data/Syntax/Algebra.hs b/src/Data/Syntax/Algebra.hs new file mode 100644 index 000000000..9ea082820 --- /dev/null +++ b/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 diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs index 27ddb9c48..e802891cf 100644 --- a/src/Language/Ruby/Syntax.hs +++ b/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 diff --git a/src/Renderer.hs b/src/Renderer.hs index cee516e13..f73fc28d0 100644 --- a/src/Renderer.hs +++ b/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 diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 200656721..de6c68601 100644 --- a/src/Renderer/JSON.hs +++ b/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 ] diff --git a/test/SemanticCmdLineSpec.hs b/test/SemanticCmdLineSpec.hs index 20c8a5ba2..f6265c6d5 100644 --- a/test/SemanticCmdLineSpec.hs +++ b/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"