1
1
mirror of https://github.com/github/semantic.git synced 2024-12-23 14:54:16 +03:00

Prepend (Category, TermName) to DiffSummary.parentAnnotations

This commit is contained in:
joshvera 2016-08-08 14:06:07 -04:00
parent c191312ece
commit 51cb8918a9

View File

@ -2,7 +2,7 @@
module DiffSummary (DiffSummary(..), diffSummaries, DiffInfo(..), annotatedSummaries) where module DiffSummary (DiffSummary(..), diffSummaries, DiffInfo(..), annotatedSummaries) where
import Prologue hiding (snd, intercalate) import Prologue hiding (intercalate)
import Diff import Diff
import Patch import Patch
import Term import Term
@ -11,7 +11,8 @@ import Range
import Syntax as S import Syntax as S
import Category as C import Category as C
import Data.Functor.Foldable as Foldable import Data.Functor.Foldable as Foldable
import Data.Functor.Both import Data.Functor.Both hiding (fst, snd)
import qualified Data.Functor.Both as Both
import Data.Text as Text (intercalate) import Data.Text as Text (intercalate)
import Test.QuickCheck hiding (Fixed) import Test.QuickCheck hiding (Fixed)
import Patch.Arbitrary() import Patch.Arbitrary()
@ -27,55 +28,31 @@ data DiffInfo = LeafInfo { categoryName :: Text, termName :: Text }
deriving (Eq, Show) deriving (Eq, Show)
data Branch = BIndexed | BFixed | BCommented deriving (Show, Eq, Generic) data Branch = BIndexed | BFixed | BCommented deriving (Show, Eq, Generic)
data DiffSummary a = DiffSummary { data DiffSummary a = DiffSummary {
patch :: Patch a, patch :: Patch a,
parentAnnotations :: [Category] parentAnnotations :: [(Category, Text)]
} deriving (Eq, Functor, Show, Generic) } deriving (Eq, Functor, Show, Generic)
annotatedSummaries :: DiffSummary DiffInfo -> [Text] annotatedSummaries :: DiffSummary DiffInfo -> [Text]
annotatedSummaries DiffSummary{..} = show . (P.<> maybeParentContext parentAnnotations) <$> summaries patch annotatedSummaries DiffSummary{..} = show . (P.<> maybeParentContext parentAnnotations) <$> summaries patch
diffSummaries :: (HasCategory leaf, HasField fields Category, HasField fields Range) => Both (Source Char) -> Diff leaf (Record fields) -> [DiffSummary DiffInfo] diffSummaries :: (HasCategory leaf, HasField fields Category, HasField fields Range) => Both (Source Char) -> Diff leaf (Record fields) -> [DiffSummary DiffInfo]
diffSummaries sources = cata $ \case diffSummaries sources = para $ \diff ->
-- Skip comments and leaves since they don't have any changes let diff' = free (Prologue.fst <$> diff)
(Free (_ :< Leaf _)) -> [] annotateWithCategory :: [(Diff leaf (Record fields), [DiffSummary DiffInfo])] -> [DiffSummary DiffInfo]
Free (_ :< (S.Comment _)) -> [] annotateWithCategory children = maybeToList (prependSummary (Both.snd sources) <$> (afterTerm diff')) <*> (children >>= snd) in
(Free (infos :< S.Indexed children)) -> annotateWithCategory infos <$> join children case diff of
(Free (infos :< S.Fixed children)) -> annotateWithCategory infos <$> join children -- Skip comments and leaves since they don't have any changes
(Free (infos :< S.FunctionCall identifier children)) -> annotateWithCategory infos <$> join (Prologue.toList (identifier : children)) Free (_ :< Leaf _) -> []
(Free (infos :< S.Function id ps body)) -> annotateWithCategory infos <$> (fromMaybe [] id) <> (fromMaybe [] ps) <> body Free (_ :< (S.Comment _)) -> []
(Free (infos :< S.Assignment id value)) -> annotateWithCategory infos <$> id <> value (Free (_ :< syntax)) -> annotateWithCategory (toList syntax)
(Free (infos :< S.MemberAccess base property)) -> annotateWithCategory infos <$> base <> property (Pure (Insert term)) -> [ DiffSummary (Insert $ termToDiffInfo afterSource term) [] ]
(Free (infos :< S.SubscriptAccess base property)) -> annotateWithCategory infos <$> base <> property (Pure (Delete term)) -> [ DiffSummary (Delete $ termToDiffInfo beforeSource term) [] ]
(Free (infos :< S.MethodCall targetId methodId ps)) -> annotateWithCategory infos <$> targetId <> methodId <> ps (Pure (Replace t1 t2)) -> [ DiffSummary (Replace (termToDiffInfo beforeSource t1) (termToDiffInfo afterSource t2)) [] ]
(Free (infos :< S.VarAssignment varId value)) -> annotateWithCategory infos <$> varId <> value
(Free (infos :< S.VarDecl decl)) -> annotateWithCategory infos <$> decl
(Free (infos :< S.Args args)) -> annotateWithCategory infos <$> join args
(Free (infos :< S.Switch expr cases)) -> annotateWithCategory infos <$> expr <> join cases
(Free (infos :< S.Case expr body)) -> annotateWithCategory infos <$> expr <> body
Free (infos :< (S.Ternary expr cases)) -> annotateWithCategory infos <$> expr <> join cases
Free (infos :< (S.MathAssignment id value)) -> annotateWithCategory infos <$> id <> value
Free (infos :< (S.Operator syntaxes)) -> annotateWithCategory infos <$> join syntaxes
Free (infos :< (S.Object kvs)) -> annotateWithCategory infos <$> join kvs
Free (infos :< (S.Return expr)) -> annotateWithCategory infos <$> fromMaybe [] expr
Free (infos :< (S.Pair a b)) -> annotateWithCategory infos <$> a <> b
Free (infos :< (S.Commented cs leaf)) -> annotateWithCategory infos <$> join cs <> fromMaybe [] leaf
Free (infos :< (S.Error _ children)) -> annotateWithCategory infos <$> join children
(Free (infos :< S.For exprs body)) -> annotateWithCategory infos <$> join exprs <> body
(Free (infos :< S.While expr body)) -> annotateWithCategory infos <$> expr <> body
(Free (infos :< S.DoWhile expr body)) -> annotateWithCategory infos <$> expr <> body
(Free (infos :< S.Throw expr)) -> annotateWithCategory infos <$> expr
(Free (infos :< S.Constructor expr)) -> annotateWithCategory infos <$> expr
(Free (infos :< S.Try expr catch finally)) -> annotateWithCategory infos <$> expr <> fromMaybe [] catch <> fromMaybe [] finally
(Free (infos :< S.Array children)) -> annotateWithCategory infos <$> join children
(Free (infos :< S.Class identifier superclass definitions)) -> annotateWithCategory infos <$> identifier <> fromMaybe [] superclass <> join definitions
(Free (infos :< S.Method identifier params definitions)) -> annotateWithCategory infos <$> identifier <> join params <> join definitions
(Pure (Insert term)) -> [ DiffSummary (Insert $ termToDiffInfo afterSource term) [] ]
(Pure (Delete term)) -> [ DiffSummary (Delete $ termToDiffInfo beforeSource term) [] ]
(Pure (Replace t1 t2)) -> [ DiffSummary (Replace (termToDiffInfo beforeSource t1) (termToDiffInfo afterSource t2)) [] ]
where where
(beforeSource, afterSource) = runJoin sources (beforeSource, afterSource) = runJoin sources
annotateWithCategory infos = prependSummary (category $ snd infos)
summaries :: Patch DiffInfo -> [P.Doc] summaries :: Patch DiffInfo -> [P.Doc]
summaries (Insert info) = (("Added" <+> "the") <+>) <$> toLeafInfos info summaries (Insert info) = (("Added" <+> "the") <+>) <$> toLeafInfos info
@ -142,10 +119,10 @@ toTermName source term = case unwrap term of
termNameFromRange range = toText $ Source.slice range source termNameFromRange range = toText $ Source.slice range source
range = characterRange . extract range = characterRange . extract
maybeParentContext :: [Category] -> Doc maybeParentContext :: [(Category, Text)] -> Doc
maybeParentContext annotations = if null annotations maybeParentContext annotations = case annotations of
then "" [] -> ""
else space <> "in the" <+> (toDoc . intercalate "/" $ toCategoryName <$> annotations) <+> "context" (annotation:xs) -> space <> "in the" <+> (toDoc $ snd annotation) <+> toDoc (toCategoryName $ fst annotation)
toDoc :: Text -> Doc toDoc :: Text -> Doc
toDoc = string . toS toDoc = string . toS
@ -168,8 +145,8 @@ termToDiffInfo blob term = case unwrap term of
where toTermName' = toTermName blob where toTermName' = toTermName blob
termToDiffInfo' = termToDiffInfo blob termToDiffInfo' = termToDiffInfo blob
prependSummary :: Category -> DiffSummary DiffInfo -> DiffSummary DiffInfo prependSummary :: (HasCategory leaf, HasField fields Range, HasField fields Category) => Source Char -> Term leaf (Record fields) -> DiffSummary DiffInfo -> DiffSummary DiffInfo
prependSummary annotation summary = summary { parentAnnotations = annotation : parentAnnotations summary } prependSummary source term summary = summary { parentAnnotations = (category $ extract term, toTermName source term) : parentAnnotations summary }
-- The user-facing category name of 'a'. -- The user-facing category name of 'a'.
class HasCategory a where class HasCategory a where