github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-01 09:15:01 +03:00
Code Issues Projects Releases Wiki Activity

Output source spans to JSON

Browse Source
This commit is contained in:
joshvera 2016-10-06 13:12:40 -04:00
parent 7121ec7fe0
commit ecf34e5d6e
3 changed files with 55 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

85
src/DiffSummary.hs
View File

@ -1,6 +1,6 @@
{-# LANGUAGE DataKinds, TypeFamilies, ScopedTypeVariables #-}
{-# LANGUAGE DataKinds, TypeFamilies, ScopedTypeVariables, DeriveAnyClass #-}
module DiffSummary (diffSummaries, DiffSummary(..), DiffInfo(..), diffToDiffSummaries, isBranchInfo) where
module DiffSummary (diffSummaries, DiffSummary(..), DiffInfo(..), diffToDiffSummaries, isBranchInfo, isErrorSummary, JSONSummary) where
import Prologue hiding (intercalate)
import Diff
@ -21,6 +21,7 @@ import Text.PrettyPrint.Leijen.Text ((<+>), squotes, space, string, Doc, punctua
import qualified Text.PrettyPrint.Leijen.Text as P
import SourceSpan
import Source
import Data.Aeson (ToJSON)
data Annotatable a = Annotatable a | Unannotatable a
@ -51,7 +52,15 @@ identifiable term = isIdentifiable (unwrap term) term
S.DoWhile{} -> Identifiable
_ -> Unidentifiable
data DiffInfo = LeafInfo { categoryName :: Text, termName :: Text }
data JSONSummary summary span = JSONSummary { summary :: summary, span :: span }
| ErrorSummary { summary :: summary, span :: span }
deriving (ToJSON, Generic)
isErrorSummary :: JSONSummary summary span -> Bool
isErrorSummary ErrorSummary{} = True
isErrorSummary _ = False
data DiffInfo = LeafInfo { categoryName :: Text, termName :: Text, sourceSpan :: SourceSpan }
| BranchInfo { branches :: [ DiffInfo ], categoryName :: Text, branchType :: Branch }
| ErrorInfo { errorSpan :: SourceSpan, termName :: Text }
deriving (Eq, Show)
@ -64,13 +73,14 @@ data DiffSummary a = DiffSummary {
} deriving (Eq, Functor, Show, Generic)
-- Returns a list of diff summary texts given two source blobs and a diff.
diffSummaries :: (HasCategory leaf, HasField fields Category, HasField fields Range, HasField fields SourceSpan) => Both SourceBlob -> SyntaxDiff leaf fields -> [Either Text Text]
diffSummaries :: (HasCategory leaf, HasField fields Category, HasField fields Range, HasField fields SourceSpan) => Both SourceBlob -> SyntaxDiff leaf fields -> [JSONSummary Text (These SourceSpan SourceSpan)]
diffSummaries blobs diff = summaryToTexts =<< diffToDiffSummaries (source <$> blobs) diff
-- Takes a 'DiffSummary' and returns a list of summary texts representing the LeafInfos
-- in that 'DiffSummary'.
summaryToTexts :: DiffSummary DiffInfo -> [Either Text Text]
summaryToTexts DiffSummary{..} = runJoin . fmap (show . (<+> parentContexts parentAnnotation)) <$> (Join <$> summaries patch)
summaryToTexts :: DiffSummary DiffInfo -> [JSONSummary Text (These SourceSpan SourceSpan)]
summaryToTexts DiffSummary{..} = (\jsonSummary ->
jsonSummary { summary = show $ summary jsonSummary <+> parentContexts parentAnnotation }) <$> summaries patch
-- Returns a list of 'DiffSummary' given two source blobs and a diff.
diffToDiffSummaries :: (HasCategory leaf, HasField fields Category, HasField fields Range, HasField fields SourceSpan) => Both (Source Char) -> SyntaxDiff leaf fields -> [DiffSummary DiffInfo]
@ -89,24 +99,27 @@ diffToDiffSummaries sources = para $ \diff ->
where
(beforeSource, afterSource) = runJoin sources
-- Returns a list of diff summary 'Docs' prefixed given a 'Patch'.
summaries :: Patch DiffInfo -> [Either Doc Doc]
summaries patch = eitherErrorOrDoc <$> patchToDoc patch
where eitherErrorOrDoc = if any hasErrorInfo patch then Left else Right
-- Flattens a patch of diff infos into a list of docs, one for every 'LeafInfo'
-- or `ErrorInfo` it contains.
patchToDoc :: Patch DiffInfo -> [Doc]
patchToDoc = \case
p@(Replace i1 i2) -> zipWith (\a b -> prefixWithPatch p a <+> "with" <+> determiner i1 <+> b) (toLeafInfos i1) (toLeafInfos i2)
p@(Insert info) -> prefixWithPatch p <$> toLeafInfos info
p@(Delete info) -> prefixWithPatch p <$> toLeafInfos info
-- Flattens a patch of diff infos into a list of docs, one for every 'LeafInfo' or `ErrorInfo` it contains.
summaries :: Patch DiffInfo -> [JSONSummary Doc (These SourceSpan SourceSpan)]
summaries = \case
p@(Replace i1 i2) -> zipWith (\a b ->
JSONSummary
{
summary = summary (prefixWithPatch p This a) <+> "with" <+> determiner i1 <+> summary b
, span = These (span a) (span b)
}) (toLeafInfos i1) (toLeafInfos i2)
p@(Insert info) -> prefixWithPatch p That <$> toLeafInfos info
p@(Delete info) -> prefixWithPatch p This <$> toLeafInfos info
-- Prefixes a given doc with the type of patch it represents.
prefixWithPatch :: Patch DiffInfo -> Doc -> Doc
prefixWithPatch patch = prefixWithThe (patchToPrefix patch)
prefixWithPatch :: Patch DiffInfo -> (SourceSpan -> These SourceSpan SourceSpan) -> JSONSummary Doc SourceSpan -> JSONSummary Doc (These SourceSpan SourceSpan)
prefixWithPatch patch constructor = prefixWithThe (patchToPrefix patch)
where
prefixWithThe prefix doc = prefix <+> determiner' patch <+> doc
prefixWithThe prefix jsonSummary = jsonSummary
{
summary = prefix <+> determiner' patch <+> summary jsonSummary
, span = constructor (span jsonSummary)
}
patchToPrefix = \case
(Replace _ _) -> "Replaced"
(Insert _) -> "Added"
@ -115,20 +128,20 @@ prefixWithPatch patch = prefixWithThe (patchToPrefix patch)
-- Optional determiner (e.g. "the") to tie together summary statements.
determiner :: DiffInfo -> Doc
determiner (LeafInfo "number" _) = ""
determiner (LeafInfo "boolean" _) = ""
determiner (LeafInfo "anonymous function" _) = "an"
determiner (LeafInfo "number" _ _) = ""
determiner (LeafInfo "boolean" _ _) = ""
determiner (LeafInfo "anonymous function" _ _) = "an"
determiner (BranchInfo bs _ _) = determiner (last bs)
determiner _ = "the"
toLeafInfos :: DiffInfo -> [Doc]
toLeafInfos (LeafInfo "number" termName) = pure (squotes (toDoc termName))
toLeafInfos (LeafInfo "boolean" termName) = pure (squotes (toDoc termName))
toLeafInfos (LeafInfo "anonymous function" termName) = pure (toDoc termName)
toLeafInfos (LeafInfo cName@"string" termName) = pure (toDoc termName <+> toDoc cName)
toLeafInfos LeafInfo{..} = pure (squotes (toDoc termName) <+> toDoc categoryName)
toLeafInfos :: DiffInfo -> [JSONSummary Doc SourceSpan]
toLeafInfos (LeafInfo "number" termName sourceSpan) = pure $ JSONSummary (squotes $ toDoc termName) sourceSpan
toLeafInfos (LeafInfo "boolean" termName sourceSpan) = pure $ JSONSummary (squotes $ toDoc termName) sourceSpan
toLeafInfos (LeafInfo "anonymous function" termName sourceSpan) = pure $ JSONSummary (toDoc termName) sourceSpan
toLeafInfos (LeafInfo cName@"string" termName sourceSpan) = pure $ JSONSummary (toDoc termName <+> toDoc cName) sourceSpan
toLeafInfos LeafInfo{..} = pure $ JSONSummary (squotes (toDoc termName) <+> toDoc categoryName) sourceSpan
toLeafInfos BranchInfo{..} = toLeafInfos =<< branches
toLeafInfos err@ErrorInfo{} = pure (pretty err)
toLeafInfos err@ErrorInfo{..} = pure $ ErrorSummary (pretty err) errorSpan
-- Returns a text representing a specific term given a source and a term.
toTermName :: forall leaf fields. (HasCategory leaf, HasField fields Category, HasField fields Range) => Source Char -> SyntaxTerm leaf fields -> Text
@ -213,10 +226,10 @@ termToDiffInfo :: (HasCategory leaf, HasField fields Category, HasField fields R
termToDiffInfo blob term = case unwrap term of
S.Indexed children -> BranchInfo (termToDiffInfo' <$> children) (toCategoryName term) BIndexed
S.Fixed children -> BranchInfo (termToDiffInfo' <$> children) (toCategoryName term) BFixed
S.AnonymousFunction _ _ -> LeafInfo "anonymous function" (toTermName' term)
S.AnonymousFunction _ _ -> LeafInfo "anonymous function" (toTermName' term) (getField $ extract term)
Commented cs leaf -> BranchInfo (termToDiffInfo' <$> cs <> maybeToList leaf) (toCategoryName term) BCommented
S.Error _ -> ErrorInfo (getField $ extract term) (toTermName' term)
_ -> LeafInfo (toCategoryName term) (toTermName' term)
_ -> LeafInfo (toCategoryName term) (toTermName' term) (getField $ extract term)
where toTermName' = toTermName blob
termToDiffInfo' = termToDiffInfo blob
@ -239,12 +252,6 @@ isBranchInfo info = case info of
BranchInfo{} -> True
_ -> False
hasErrorInfo :: DiffInfo -> Bool
hasErrorInfo info = case info of
(ErrorInfo _ _) -> True
(BranchInfo branches _ _) -> any hasErrorInfo branches
_ -> False
-- The user-facing category name of 'a'.
class HasCategory a where
toCategoryName :: a -> Text

4
src/Renderer.hs
View File

@ -20,7 +20,7 @@ data DiffArguments = DiffArguments { format :: Format, output :: Maybe FilePath
data Format = Split | Patch | JSON | Summary
deriving (Show)
data Output = SplitOutput Text | PatchOutput Text | JSONOutput (Map Text Value) | SummaryOutput (Map Text (Map Text [Text]))
data Output = SplitOutput Text | PatchOutput Text | JSONOutput (Map Text Value) | SummaryOutput (Map Text (Map Text [Value]))
deriving (Show)
-- Returns a key representing the filename. If the filenames are different,
@ -47,7 +47,7 @@ concatOutputs list | isJSON list = toS . encodingToLazyByteString . toEncoding $
concatJSON _ = mempty
concatOutputs list | isSummary list = toS . encodingToLazyByteString . toEncoding $ concatSummaries list
where
concatSummaries :: [Output] -> Map Text (Map Text [Text])
concatSummaries :: [Output] -> Map Text (Map Text [Value])
concatSummaries (SummaryOutput hash : rest) = Map.unionWith (Map.unionWith (<>)) hash (concatSummaries rest)
concatSummaries _ = mempty
concatOutputs list | isText list = T.intercalate "\n" (toText <$> list)

11
src/Renderer/Summary.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TupleSections, ScopedTypeVariables #-}
module Renderer.Summary where
import Category
@ -10,6 +10,9 @@ import DiffSummary
import Data.Map as Map hiding (null)
import Source
import SourceSpan
import Data.These
import Data.Aeson
import Data.List as List
summary :: (HasField fields Category, HasField fields Range, HasField fields SourceSpan) => Renderer (Record fields)
summary blobs diff = SummaryOutput $ Map.fromList [
@ -17,8 +20,8 @@ summary blobs diff = SummaryOutput $ Map.fromList [
("errors", errors)
]
where
changes = if null changes' then mempty else Map.singleton summaryKey changes'
errors = if null errors' then mempty else Map.singleton summaryKey errors'
(errors', changes') = partitionEithers summaries
changes = if null changes' then mempty else Map.singleton summaryKey (toJSON <$> changes')
errors = if null errors' then mempty else Map.singleton summaryKey (toJSON <$> errors')
(errors' :: [JSONSummary Text (These SourceSpan SourceSpan)], changes' :: [JSONSummary Text (These SourceSpan SourceSpan)]) = List.partition isErrorSummary summaries
summaryKey = toSummaryKey (path <$> blobs)
summaries = diffSummaries blobs diff