mirror of
https://github.com/github/semantic.git
synced 2024-12-23 06:41:45 +03:00
Prepend (Category, TermName) to DiffSummary.parentAnnotations
This commit is contained in:
joshvera
parent
c191312ece
commit
51cb8918a9
@ -2,7 +2,7 @@
|
||||
|
||||
module DiffSummary (DiffSummary(..), diffSummaries, DiffInfo(..), annotatedSummaries) where
|
||||
|
||||
import Prologue hiding (snd, intercalate)
|
||||
import Prologue hiding (intercalate)
|
||||
import Diff
|
||||
import Patch
|
||||
import Term
|
||||
@ -11,7 +11,8 @@ import Range
|
||||
import Syntax as S
|
||||
import Category as C
|
||||
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 Test.QuickCheck hiding (Fixed)
|
||||
import Patch.Arbitrary()
|
||||
@ -27,55 +28,31 @@ data DiffInfo = LeafInfo { categoryName :: Text, termName :: Text }
|
||||
deriving (Eq, Show)
|
||||
|
||||
data Branch = BIndexed | BFixed | BCommented deriving (Show, Eq, Generic)
|
||||
|
||||
data DiffSummary a = DiffSummary {
|
||||
patch :: Patch a,
|
||||
parentAnnotations :: [Category]
|
||||
parentAnnotations :: [(Category, Text)]
|
||||
} deriving (Eq, Functor, Show, Generic)
|
||||
|
||||
annotatedSummaries :: DiffSummary DiffInfo -> [Text]
|
||||
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 sources = cata $ \case
|
||||
diffSummaries sources = para $ \diff ->
|
||||
let diff' = free (Prologue.fst <$> diff)
|
||||
annotateWithCategory :: [(Diff leaf (Record fields), [DiffSummary DiffInfo])] -> [DiffSummary DiffInfo]
|
||||
annotateWithCategory children = maybeToList (prependSummary (Both.snd sources) <$> (afterTerm diff')) <*> (children >>= snd) in
|
||||
case diff of
|
||||
-- Skip comments and leaves since they don't have any changes
|
||||
(Free (_ :< Leaf _)) -> []
|
||||
Free (_ :< Leaf _) -> []
|
||||
Free (_ :< (S.Comment _)) -> []
|
||||
(Free (infos :< S.Indexed children)) -> annotateWithCategory infos <$> join children
|
||||
(Free (infos :< S.Fixed children)) -> annotateWithCategory infos <$> join children
|
||||
(Free (infos :< S.FunctionCall identifier children)) -> annotateWithCategory infos <$> join (Prologue.toList (identifier : children))
|
||||
(Free (infos :< S.Function id ps body)) -> annotateWithCategory infos <$> (fromMaybe [] id) <> (fromMaybe [] ps) <> body
|
||||
(Free (infos :< S.Assignment id value)) -> annotateWithCategory infos <$> id <> value
|
||||
(Free (infos :< S.MemberAccess base property)) -> annotateWithCategory infos <$> base <> property
|
||||
(Free (infos :< S.SubscriptAccess base property)) -> annotateWithCategory infos <$> base <> property
|
||||
(Free (infos :< S.MethodCall targetId methodId ps)) -> annotateWithCategory infos <$> targetId <> methodId <> ps
|
||||
(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
|
||||
(Free (_ :< syntax)) -> annotateWithCategory (toList syntax)
|
||||
(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
|
||||
(beforeSource, afterSource) = runJoin sources
|
||||
annotateWithCategory infos = prependSummary (category $ snd infos)
|
||||
|
||||
|
||||
summaries :: Patch DiffInfo -> [P.Doc]
|
||||
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
|
||||
range = characterRange . extract
|
||||
|
||||
maybeParentContext :: [Category] -> Doc
|
||||
maybeParentContext annotations = if null annotations
|
||||
then ""
|
||||
else space <> "in the" <+> (toDoc . intercalate "/" $ toCategoryName <$> annotations) <+> "context"
|
||||
maybeParentContext :: [(Category, Text)] -> Doc
|
||||
maybeParentContext annotations = case annotations of
|
||||
[] -> ""
|
||||
(annotation:xs) -> space <> "in the" <+> (toDoc $ snd annotation) <+> toDoc (toCategoryName $ fst annotation)
|
||||
toDoc :: Text -> Doc
|
||||
toDoc = string . toS
|
||||
|
||||
@ -168,8 +145,8 @@ termToDiffInfo blob term = case unwrap term of
|
||||
where toTermName' = toTermName blob
|
||||
termToDiffInfo' = termToDiffInfo blob
|
||||
|
||||
prependSummary :: Category -> DiffSummary DiffInfo -> DiffSummary DiffInfo
|
||||
prependSummary annotation summary = summary { parentAnnotations = annotation : parentAnnotations summary }
|
||||
prependSummary :: (HasCategory leaf, HasField fields Range, HasField fields Category) => Source Char -> Term leaf (Record fields) -> DiffSummary DiffInfo -> DiffSummary DiffInfo
|
||||
prependSummary source term summary = summary { parentAnnotations = (category $ extract term, toTermName source term) : parentAnnotations summary }
|
||||
|
||||
-- The user-facing category name of 'a'.
|
||||
class HasCategory a where
|
||||
|
||||
Loading…
Reference in New Issue
Block a user