github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-02 20:41:38 +03:00
Code Issues Projects Releases Wiki Activity

Allow printing only tree of sexpression output

Browse Source
This commit is contained in:
Timothy Clem 2017-02-21 14:01:39 -08:00
parent 178a942166
commit 6165a6dd02
3 changed files with 20 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Diffing.hs
View File

@ -77,7 +77,7 @@ textDiff :: (ToJSON (Record fields), DefaultFields fields, HasField fields Cost)
textDiff parser arguments = diffFiles parser $ case format arguments of
Split -> split
Patch -> patch
SExpression -> sExpression
SExpression -> sExpression TreeOnly
JSON -> json
Summary -> summary
TOC -> toc

2
src/Parse.hs
View File

@ -42,7 +42,7 @@ run Arguments{..} = do
terms <- zipWithM (\parser sourceBlob -> parser sourceBlob) parsers (sourceBlobs sources)
writeToOutput output $ case format of
SExpression -> [foldr (\t acc -> printTerm t 0 <> acc) "" terms]
SExpression -> [foldr (\t acc -> printTerm t 0 TreeAndRanges <> acc) "" terms]
_ -> toS . encodePretty . cata algebra <$> terms
where

33
src/Renderer/SExpression.hs
View File

@ -1,5 +1,5 @@
{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
module Renderer.SExpression (sExpression, printTerm) where
module Renderer.SExpression (sExpression, printTerm, SExpressionFormat(..)) where
import Data.Bifunctor.Join
import Data.Foldable
@ -15,33 +15,36 @@ import Info
import Syntax
import Term
sExpression :: (HasField fields Category, HasField fields SourceSpan) => Renderer (Record fields)
sExpression _ diff = SExpressionOutput $ printDiff diff 0
data SExpressionFormat = TreeOnly | TreeAndRanges
printDiff :: (HasField fields Category, HasField fields SourceSpan) => Diff (Syntax Text) (Record fields) -> Int -> Text
printDiff diff level = case runFree diff of
sExpression :: (HasField fields Category, HasField fields SourceSpan) => SExpressionFormat -> Renderer (Record fields)
sExpression format _ diff = SExpressionOutput $ printDiff diff 0 format
printDiff :: (HasField fields Category, HasField fields SourceSpan) => Diff (Syntax Text) (Record fields) -> Int -> SExpressionFormat -> Text
printDiff diff level format = case runFree diff of
(Pure patch) -> case patch of
Insert term -> pad (level - 1) <> "{+" <> printTerm term level <> "+}"
Delete term -> pad (level - 1) <> "{-" <> printTerm term level <> "-}"
Replace a b -> pad (level - 1) <> "{" <> printTerm a level <> "->" <> printTerm b level <> "}"
(Free (Join (_, annotation) :< syntax)) -> pad' level <> "(" <> showAnnotation annotation <> foldr (\d acc -> printDiff d (level + 1) <> acc) "" syntax <> ")"
Insert term -> pad (level - 1) <> "{+" <> printTerm term level format <> "+}"
Delete term -> pad (level - 1) <> "{-" <> printTerm term level format <> "-}"
Replace a b -> pad (level - 1) <> "{ " <> printTerm a level format <> pad (level - 1) <> "->" <> printTerm b level format <> " }"
(Free (Join (_, annotation) :< syntax)) -> pad' level <> "(" <> showAnnotation annotation format <> foldr (\d acc -> printDiff d (level + 1) format <> acc) "" syntax <> ")"
where
pad' n = if n < 1 then "" else pad n
pad n | n < 0 = ""
| n < 1 = "\n"
| otherwise = "\n" <> mconcat (replicate n " ")
printTerm :: (HasField fields Category, HasField fields SourceSpan) => Term (Syntax t) (Record fields) -> Int -> Text
printTerm term level = go term level 0
printTerm :: (HasField fields Category, HasField fields SourceSpan) => Term (Syntax t) (Record fields) -> Int -> SExpressionFormat ->Text
printTerm term level format = go term level 0
where
pad p n | n < 1 = ""
| otherwise = "\n" <> mconcat (replicate (p + n) " ")
go term parentLevel level = case runCofree term of
(annotation :< Leaf _) -> pad parentLevel level <> "(" <> showAnnotation annotation <> ")"
(annotation :< syntax) -> pad parentLevel level <> "(" <> showAnnotation annotation <> foldr (\t acc -> go t parentLevel (level + 1) <> acc) "" syntax <> ")"
(annotation :< Leaf _) -> pad parentLevel level <> "(" <> showAnnotation annotation format <> ")"
(annotation :< syntax) -> pad parentLevel level <> "(" <> showAnnotation annotation format <> foldr (\t acc -> go t parentLevel (level + 1) <> acc) "" syntax <> ")"
showAnnotation :: (HasField fields Category, HasField fields SourceSpan) => Record fields -> Text
showAnnotation annotation = categoryName annotation <> " " <> showSourceSpan annotation
showAnnotation :: (HasField fields Category, HasField fields SourceSpan) => Record fields -> SExpressionFormat -> Text
showAnnotation annotation TreeOnly = categoryName annotation
showAnnotation annotation TreeAndRanges = categoryName annotation <> " " <> showSourceSpan annotation
where
showSourceSpan a = start a <> " - " <> end a
start = showPoint . spanStart . getField