🔥 the TreeAndRanges format of sexpr rendering.

src/Arguments.hs

@@ -49,7 +49,7 @@ jsonDiff :: DiffArguments'
 jsonDiff = DiffArguments JSONRenderer (const identifierDecorator)
 
 sExpressionDiff :: DiffArguments'
-sExpressionDiff = DiffArguments (SExpressionDiffRenderer TreeOnly) identityDecorator
+sExpressionDiff = DiffArguments SExpressionDiffRenderer identityDecorator
 
 tocDiff :: DiffArguments'
 tocDiff = DiffArguments ToCRenderer declarationDecorator
@@ -71,7 +71,7 @@ deriving instance Show ParseArguments
 type ParseArguments' = ParseMode -> FilePath -> [FilePath] -> ParseArguments
 
 sExpressionParseTree :: ParseArguments'
-sExpressionParseTree = ParseArguments (SExpressionParseTreeRenderer TreeOnly)
+sExpressionParseTree = ParseArguments SExpressionParseTreeRenderer
 
 jsonParseTree :: ParseArguments'
 jsonParseTree = ParseArguments JSONRenderer

src/Renderer.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE DataKinds, GADTs, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators #-}
 module Renderer
 ( Renderer(..)
-, SExpressionFormat(..)
 , runRenderer
 , declarationDecorator
 , identifierDecorator
@@ -11,7 +10,6 @@ module Renderer
 
 import Data.Aeson (ToJSON, Value, (.=))
 import Data.Functor.Both hiding (fst, snd)
-import Data.Functor.Classes
 import Text.Show
 import Data.Record
 import Data.Syntax.Algebra (RAlgebra, decoratorWithAlgebra)
@@ -30,17 +28,17 @@ import Term
 data Renderer input output where
   PatchRenderer :: HasField fields Range => Renderer (Both SourceBlob, Diff (Syntax Text) (Record fields)) File
   JSONRenderer :: (ToJSON a, Foldable t) => Renderer (t SourceBlob, a) [Value]
-  SExpressionDiffRenderer :: (HasField fields Category, HasField fields SourceSpan, Foldable f) => SExpressionFormat -> Renderer (Both SourceBlob, Diff f (Record fields)) ByteString
+  SExpressionDiffRenderer :: (HasField fields Category, HasField fields SourceSpan, Foldable f) => Renderer (Both SourceBlob, Diff f (Record fields)) ByteString
   ToCRenderer :: (HasField fields Category, HasField fields (Maybe Declaration), HasField fields SourceSpan) => Renderer (Both SourceBlob, Diff (Syntax Text) (Record fields)) Summaries
-  SExpressionParseTreeRenderer :: (HasField fields Category, HasField fields SourceSpan, Foldable f) => SExpressionFormat -> Renderer (Identity SourceBlob, Term f (Record fields)) ByteString
+  SExpressionParseTreeRenderer :: (HasField fields Category, HasField fields SourceSpan, Foldable f) => Renderer (Identity SourceBlob, Term f (Record fields)) ByteString
 
 runRenderer :: (Monoid output, StringConv output ByteString) => Renderer input output -> input -> output
 runRenderer renderer = case renderer of
   PatchRenderer -> File . uncurry R.patch
   JSONRenderer -> uncurry R.json
-  SExpressionDiffRenderer format -> R.sExpression format . snd
+  SExpressionDiffRenderer -> R.sExpression . snd
   ToCRenderer -> uncurry R.toc
-  SExpressionParseTreeRenderer format -> R.sExpressionParseTree format . snd
+  SExpressionParseTreeRenderer -> R.sExpressionParseTree . snd
 
 
 declarationDecorator :: Source -> Term (Syntax Text) (Record DefaultFields) -> Term (Syntax Text) (Record (Maybe Declaration ': DefaultFields))
@@ -81,9 +79,9 @@ instance StringConv File ByteString where
 instance Show (Renderer input output) where
   showsPrec _ PatchRenderer = showString "PatchRenderer"
   showsPrec _ JSONRenderer = showString "JSONRenderer"
-  showsPrec d (SExpressionDiffRenderer format) = showsUnaryWith showsPrec "SExpressionDiffRenderer" d format
+  showsPrec _ SExpressionDiffRenderer = showString "SExpressionDiffRenderer"
   showsPrec _ ToCRenderer = showString "ToCRenderer"
-  showsPrec d (SExpressionParseTreeRenderer format) = showsUnaryWith showsPrec "SExpressionParseTreeRenderer" d format
+  showsPrec _ SExpressionParseTreeRenderer = showString "SExpressionParseTreeRenderer"
 
 instance Monoid File where
   mempty = File mempty

src/Renderer/SExpression.hs

@@ -2,7 +2,6 @@
 module Renderer.SExpression
 ( sExpression
 , sExpressionParseTree
-, SExpressionFormat(..)
 ) where
 
 import Data.Bifunctor.Join
@@ -15,24 +14,21 @@ import Patch
 import Info
 import Term
 
-data SExpressionFormat = TreeOnly | TreeAndRanges
-  deriving (Show)
-
 -- | Returns a ByteString SExpression formatted diff.
-sExpression :: (HasField fields Category, HasField fields SourceSpan, Foldable f) => SExpressionFormat -> Diff f (Record fields) -> ByteString
-sExpression format diff = printDiff diff 0 format <> "\n"
+sExpression :: (HasField fields Category, HasField fields SourceSpan, Foldable f) => Diff f (Record fields) -> ByteString
+sExpression diff = printDiff diff 0 <> "\n"
 
 -- | Returns a ByteString SExpression formatted term.
-sExpressionParseTree :: (HasField fields Category, HasField fields SourceSpan, Foldable f) => SExpressionFormat -> Term f (Record fields) -> ByteString
-sExpressionParseTree format term = printTerm term 0 format <> "\n"
+sExpressionParseTree :: (HasField fields Category, HasField fields SourceSpan, Foldable f) => Term f (Record fields) -> ByteString
+sExpressionParseTree term = printTerm term 0 <> "\n"
 
-printDiff :: (HasField fields Category, HasField fields SourceSpan, Foldable f) => Diff f (Record fields) -> Int -> SExpressionFormat -> ByteString
-printDiff diff level format = case runFree diff of
+printDiff :: (HasField fields Category, HasField fields SourceSpan, Foldable f) => Diff f (Record fields) -> Int -> ByteString
+printDiff diff level = case runFree diff of
   (Pure patch) -> case patch of
-    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 <> ")"
+    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 <> pad (level - 1) <> "->" <> printTerm b level <> " }"
+  (Free (Join (_, annotation) :< syntax)) -> pad' level <> "(" <> showAnnotation annotation <> foldr (\d acc -> printDiff d (level + 1) <> acc) "" syntax <> ")"
   where
     pad' :: Int -> ByteString
     pad' n = if n < 1 then "" else pad n
@@ -41,27 +37,18 @@ printDiff diff level format = case runFree diff of
           | n < 1 = "\n"
           | otherwise = "\n" <> replicate (2 * n) space
 
-printTerm :: (HasField fields Category, HasField fields SourceSpan, Foldable f) => Term f (Record fields) -> Int -> SExpressionFormat -> ByteString
-printTerm term level format = go term level 0
+printTerm :: (HasField fields Category, HasField fields SourceSpan, Foldable f) => Term f (Record fields) -> Int -> ByteString
+printTerm term level = go term level 0
   where
     pad :: Int -> Int -> ByteString
     pad p n | n < 1 = ""
             | otherwise = "\n" <> replicate (2 * (p + n)) space
     go :: (HasField fields Category, HasField fields SourceSpan, Foldable f) => Term f (Record fields) -> Int -> Int -> ByteString
     go term parentLevel level = case runCofree term of
-      (annotation :< syntax) -> pad parentLevel level <> "(" <> showAnnotation annotation format <> foldr (\t acc -> go t parentLevel (level + 1) <> acc) "" syntax <> ")"
+      (annotation :< syntax) -> pad parentLevel level <> "(" <> showAnnotation annotation <> foldr (\t acc -> go t parentLevel (level + 1) <> acc) "" syntax <> ")"
 
-showAnnotation :: (HasField fields Category, HasField fields SourceSpan) => Record fields -> SExpressionFormat -> ByteString
-showAnnotation annotation TreeOnly = categoryName annotation
-showAnnotation annotation TreeAndRanges = categoryName annotation <> " " <> showSourceSpan annotation
-  where
-    showSourceSpan a = start a <> " - " <> end a
-    start = showPoint . spanStart . getField
-    end = showPoint . spanEnd . getField
-    showPoint SourcePos{..} = "[" <> show line <> ", " <> show column <> "]"
-
-categoryName :: HasField fields Category => Record fields -> ByteString
-categoryName = toS . category
+showAnnotation :: (HasField fields Category, HasField fields SourceSpan) => Record fields -> ByteString
+showAnnotation = toS . category
 
 space :: Word8
 space = fromIntegral $ ord ' '