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

Correct s-expression output on the first line.

Browse Source
This commit is contained in:
Rob Rix 2017-09-09 23:16:24 +01:00
parent 760955c120
commit 8fff046b02
1 changed files with 13 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
src/Renderer/SExpression.hs
View File

@ -22,23 +22,26 @@ renderSExpressionDiff diff = cata printDiffF diff 0 <> "\n"
-- | Returns a ByteString SExpression formatted term.
renderSExpressionTerm :: (ConstrainAll Show fields, Foldable f, Functor f) => Term f (Record fields) -> ByteString
renderSExpressionTerm term = cata (\ term level -> pad level <> printTermF term level) term 0 <> "\n"
renderSExpressionTerm term = cata (\ term n -> nl n <> replicate (2 * n) ' ' <> printTermF term n) term 0 <> "\n"
printDiffF :: (ConstrainAll Show fields, Foldable f, Functor f) => DiffF f (Record fields) (Int -> ByteString) -> Int -> ByteString
printDiffF diff level = case diff of
printDiffF diff n = case diff of
Patch patch -> case patch of
Insert term -> pad (level - 1) <> "{+" <> printTermF term level <> "+}"
Delete term -> pad (level - 1) <> "{-" <> printTermF term level <> "-}"
Replace a b -> pad (level - 1) <> "{ " <> printTermF a level <> pad (level - 1) <> "->" <> printTermF b level <> " }"
Copy vs (Join (_, annotation)) syntax -> pad level <> "(" <> showBindings (fmap (\ b -> b level) <$> vs) <> showAnnotation annotation <> foldMap (\ d -> d (level + 1)) syntax <> ")"
Var v -> pad level <> showMetaVar v
Insert term -> nl n <> pad (n - 1) <> "{+" <> printTermF term n <> "+}"
Delete term -> nl n <> pad (n - 1) <> "{-" <> printTermF term n <> "-}"
Replace a b -> nl n <> pad (n - 1) <> "{ " <> printTermF a n <> nl n <> pad (n - 1) <> "->" <> printTermF b n <> " }"
Copy vs (Join (_, annotation)) syntax -> nl n <> pad n <> "(" <> showBindings (fmap (\ b -> b n) <$> vs) <> showAnnotation annotation <> foldMap (\ d -> d (n + 1)) syntax <> ")"
Var v -> nl n <> pad n <> showMetaVar v
printTermF :: (ConstrainAll Show fields, Foldable f, Functor f) => TermF f (Record fields) (Int -> ByteString) -> Int -> ByteString
printTermF (annotation :< syntax) level = "(" <> showAnnotation annotation <> foldMap (\t -> t (level + 1)) syntax <> ")"
printTermF (annotation :< syntax) n = "(" <> showAnnotation annotation <> foldMap (\t -> t (n + 1)) syntax <> ")"
nl :: Int -> ByteString
nl n | n <= 0 = ""
| otherwise = "\n"
pad :: Int -> ByteString
pad n | n <= 0 = ""
| otherwise = "\n" <> replicate (2 * n) ' '
pad n = replicate (2 * n) ' '
showAnnotation :: ConstrainAll Show fields => Record fields -> ByteString